mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-15 09:23:44 +00:00
7ebb01cf12
... because they are almost always passed together, and grouping them
makes this clear. Also, code with shorter argument lists is more readable.
compiler/options_file.m:
Define the types of the collective structures. Defined them here
because one of them is defined here, and all the others are
lists of strings.
compiler/make.make_info.m:
Store one of its collective structures instead of its components.
compiler/make.build.m:
compiler/make.get_module_dep_info.m:
compiler/make.library_install.m:
compiler/make.module_target.m:
compiler/make.program_target.m:
compiler/make.top_level.m:
compiler/make.track_flags.m:
compiler/mercury_compile_args.m:
compiler/mercury_compile_main.m:
Conform to the changes above.
1634 lines
69 KiB
Mathematica
1634 lines
69 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 2002-2012 The University of Melbourne.
|
|
% Copyright (C) 2013-2017, 2019-2025 The Mercury team.
|
|
% This file may only be copied under the terms of the GNU General
|
|
% Public License - see the file COPYING in the Mercury distribution.
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% File: make.library_install.m.
|
|
%
|
|
% Build targets which install libraries.
|
|
%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- module make.library_install.
|
|
:- interface.
|
|
|
|
:- import_module libs.
|
|
:- import_module libs.globals.
|
|
:- import_module libs.maybe_util.
|
|
:- import_module make.make_info.
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.sym_name.
|
|
|
|
:- import_module io.
|
|
:- import_module list.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% install_library(ProgressStream, Globals, MainModuleName,
|
|
% AllModuleNames, Succeeded, !Info, !IO):
|
|
%
|
|
% Install
|
|
%
|
|
% - all non-grade-specific (and if applicable, pseudo-grade-specific) files
|
|
% for the current grade, all of which we presume have been built already,
|
|
% and
|
|
%
|
|
% - all grade-specific files for all library grades, which we presume
|
|
% to have been built already *only* for the current grade.
|
|
%
|
|
% The installs are *always* done to the destinations required by the
|
|
% LEGACY install directory structure, and are *also* done to the PROPOSED
|
|
% install directory structure *if* the --experiment4 option is given.
|
|
%
|
|
:- pred install_library(io.text_output_stream::in, globals::in,
|
|
module_name::in, list(module_name)::in, maybe_succeeded::out,
|
|
make_info::in, make_info::out, io::di, io::uo) is det.
|
|
|
|
% install_library_gs_gas(ProgressStream, Globals, MainModuleName,
|
|
% AllModuleNames, Succeeded, !Info, !IO):
|
|
%
|
|
% Install
|
|
%
|
|
% - all grade-specific files for the current grade, which we presume
|
|
% to have been built already.
|
|
%
|
|
% This target is designed to be used by the code that does PROPOSED
|
|
% library installs for mmake. When that code installs a library,
|
|
% it needs to be able to install the grade-specific files of *all*
|
|
% libgrades, including the ones that mmake does not support (the Java
|
|
% and C# grades). The relevant mmake rules are constructed by code in
|
|
% generate_mmakefile_fragments.m, and they are then put into the .dep file
|
|
% of the main module of the library,
|
|
%
|
|
% Installs are *always* done to the destinations required by the
|
|
% PROPOSED install directory structure. This is because the mmake target
|
|
% that this predicate implements is used *only* by code that assumes
|
|
% that structure.
|
|
%
|
|
:- pred install_library_gs_gas(io.text_output_stream::in, globals::in,
|
|
module_name::in, list(module_name)::in, maybe_succeeded::out,
|
|
make_info::in, make_info::out, io::di, io::uo) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module libs.copy_util.
|
|
:- import_module libs.file_util.
|
|
:- import_module libs.handle_options.
|
|
:- import_module libs.options.
|
|
:- import_module libs.process_util.
|
|
:- import_module libs.shell_util.
|
|
:- import_module libs.system_cmds.
|
|
:- import_module libs.timestamp.
|
|
:- import_module make.clean.
|
|
:- import_module make.get_module_dep_info.
|
|
:- import_module make.options_file.
|
|
:- import_module make.program_target. % for make_misc_target
|
|
:- import_module make.timestamp.
|
|
:- import_module make.util.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.error_spec.
|
|
:- import_module parse_tree.file_names.
|
|
:- import_module parse_tree.maybe_error.
|
|
:- import_module parse_tree.module_cmds.
|
|
:- import_module parse_tree.module_dep_info.
|
|
:- import_module parse_tree.write_error_spec.
|
|
|
|
:- import_module bool.
|
|
:- import_module cord.
|
|
:- import_module dir.
|
|
:- import_module map.
|
|
:- import_module pair.
|
|
:- import_module require.
|
|
:- import_module set.
|
|
:- import_module string.
|
|
:- import_module version_hash_table.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
install_library(ProgressStream, Globals, MainModuleName, AllModuleNames,
|
|
!:Succeeded, !Info, !IO) :-
|
|
install_library_non_grade_specific_files(ProgressStream, Globals,
|
|
AllModuleNames, NgsLibDirMap, !:Succeeded, !Info, !IO),
|
|
install_library_grade_specific_files_for_all_libgrades(ProgressStream,
|
|
Globals, NgsLibDirMap, MainModuleName, AllModuleNames,
|
|
!Succeeded, !Info, !IO).
|
|
|
|
install_library_gs_gas(ProgressStream, Globals, MainModuleName, AllModuleNames,
|
|
!:Succeeded, !Info, !IO) :-
|
|
globals.get_grade_dir(Globals, CurGrade),
|
|
proposed_install_library_grade_specific_files_for_grade(ProgressStream,
|
|
Globals, CurGrade, MainModuleName, AllModuleNames,
|
|
succeeded, !:Succeeded, !Info, !IO).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% The code to install non-grade-specific files for both the LEGACY
|
|
% and the (eventually) PROPOSED install directory structure.
|
|
%
|
|
|
|
:- pred install_library_non_grade_specific_files(io.text_output_stream::in,
|
|
globals::in, list(module_name)::in, libdir_map::out, maybe_succeeded::out,
|
|
make_info::in, make_info::out, io::di, io::uo) is det.
|
|
|
|
install_library_non_grade_specific_files(ProgressStream, Globals,
|
|
AllModuleNames, NgsLibDirMap, !:Succeeded, !Info, !IO) :-
|
|
legacy_install_library_non_grade_specific_files(ProgressStream, Globals,
|
|
AllModuleNames, NgsLibDirMap, LegacySucceeded, !Info, !IO),
|
|
globals.lookup_bool_option(Globals, experiment4, InstallProposed),
|
|
(
|
|
InstallProposed = no,
|
|
!:Succeeded = LegacySucceeded
|
|
;
|
|
InstallProposed = yes,
|
|
proposed_install_library_non_grade_specific_files(ProgressStream,
|
|
Globals, AllModuleNames, ProposedSucceeded, !Info, !IO),
|
|
!:Succeeded = LegacySucceeded `and` ProposedSucceeded
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% The code to install non-grade-specific files for the LEGACY install
|
|
% directory structure.
|
|
%
|
|
|
|
:- pred legacy_install_library_non_grade_specific_files(
|
|
io.text_output_stream::in, globals::in,
|
|
list(module_name)::in, libdir_map::out, maybe_succeeded::out,
|
|
make_info::in, make_info::out, io::di, io::uo) is det.
|
|
|
|
legacy_install_library_non_grade_specific_files(ProgressStream, Globals,
|
|
AllModuleNames, NgsLibDirMap, !:Succeeded, !Info, !IO) :-
|
|
legacy_make_non_grade_specific_install_dirs(ProgressStream, Globals,
|
|
DirSucceeded, NgsLibDirMap, !IO),
|
|
(
|
|
DirSucceeded = succeeded,
|
|
% Note that install_ints_and_headers_for_module actually installs
|
|
% some grade-specific files in non-grade-specific directories.
|
|
list.foldl3(
|
|
legacy_install_ints_and_headers_for_module(ProgressStream, Globals,
|
|
NgsLibDirMap),
|
|
AllModuleNames, succeeded, !:Succeeded, !Info, !IO),
|
|
|
|
legacy_install_extra_headers(ProgressStream, Globals, !Succeeded, !IO)
|
|
;
|
|
DirSucceeded = did_not_succeed,
|
|
!:Succeeded = did_not_succeed
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pred legacy_make_non_grade_specific_install_dirs(io.text_output_stream::in,
|
|
globals::in, maybe_succeeded::out, libdir_map::out, io::di, io::uo) is det.
|
|
|
|
legacy_make_non_grade_specific_install_dirs(ProgressStream, Globals,
|
|
!:DirSucceeded, !:NgsLibDirMap, !IO) :-
|
|
!:DirSucceeded = succeeded,
|
|
map.init(!:NgsLibDirMap),
|
|
globals.lookup_string_option(Globals, install_prefix, Prefix),
|
|
LibDir = Prefix / "lib" / "mercury",
|
|
legacy_make_nonext_dir(ProgressStream, LibDir / "inc",
|
|
!DirSucceeded, !IO),
|
|
legacy_make_nonext_dir(ProgressStream, LibDir / "modules",
|
|
!DirSucceeded, !IO),
|
|
|
|
IntsSubDir = LibDir / "ints",
|
|
legacy_make_nonext_dir(ProgressStream, IntsSubDir / "Mercury",
|
|
!DirSucceeded, !IO),
|
|
|
|
SubDirs = ["int0s", "ints", "int2s", "int3s", "opts",
|
|
"mhs", "mihs", "module_deps"],
|
|
|
|
globals.lookup_bool_option(Globals, use_symlinks, UseSymLinks),
|
|
(
|
|
UseSymLinks = yes,
|
|
% NOTE The point of using symlinks here is to save some space
|
|
% in the install directory. We want install non-grade-specific files
|
|
% into e.g. *both*
|
|
%
|
|
% LibDir / "ints"
|
|
% for compiler invocations with --no-use-subdirs
|
|
%
|
|
% *and* into
|
|
%
|
|
% LibDir / "ints" / "Mercury" / ExtDir
|
|
% for compiler invocations with --use-subdirs
|
|
%
|
|
% where ExtDir is the extension-specific directory name, such as
|
|
% "int0s".
|
|
%
|
|
% By making the latter pathname a symlink to the former, a single
|
|
% copy will be found by both kinds of compiler invocations.
|
|
%
|
|
% XXX Another way to accomplish the same goal would be to copy
|
|
% e.g. .int0 files to LibDir / "ints" / "Mercury" / "int0s", and
|
|
% add a symlink to that file to LibDir / "ints". The main benefit of
|
|
% that approach would be the avoidance of the upward-pointing symlink,
|
|
% which makes it impossibe to back up install directories using scp.
|
|
% A minor benefit is the avoidance of the need to traverse a symlink
|
|
% during --use-subdirs compiler invocations, with a corresponding new
|
|
% minor cost being the introduction of the need to traverse a symlink
|
|
% during --no-use-subdirs compiler invocations.
|
|
list.foldl3(
|
|
legacy_make_ngs_dir_symlink_to_cur(ProgressStream, IntsSubDir),
|
|
SubDirs, !DirSucceeded, !NgsLibDirMap, !IO)
|
|
;
|
|
UseSymLinks = no,
|
|
list.foldl3(
|
|
legacy_make_ngs_dir(ProgressStream, IntsSubDir),
|
|
SubDirs, !DirSucceeded, !NgsLibDirMap, !IO)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pred legacy_install_ints_and_headers_for_module(io.text_output_stream::in,
|
|
globals::in, libdir_map::in, module_name::in,
|
|
maybe_succeeded::in, maybe_succeeded::out,
|
|
make_info::in, make_info::out, io::di, io::uo) is det.
|
|
|
|
legacy_install_ints_and_headers_for_module(ProgressStream, Globals,
|
|
NgsLibDirMap, ModuleName, !Succeeded, !Info, !IO) :-
|
|
get_maybe_module_dep_info(ProgressStream, Globals,
|
|
ModuleName, MaybeModuleDepInfo, !Info, !IO),
|
|
(
|
|
MaybeModuleDepInfo = some_module_dep_info(ModuleDepInfo),
|
|
% We always install the `.int0' files for a library even though they
|
|
% are only required by the `.opt' files. This is because when building
|
|
% a program with --intermodule-optimization enabled, the compiler will
|
|
% look for `.int0' files of any libraries the program uses. It will do
|
|
% this even for libraries that were not installed with
|
|
% --intermodule-optimization enabled, returning an error if it cannot
|
|
% find the `.int0' file.
|
|
module_dep_info_get_children(ModuleDepInfo, Children),
|
|
( if set.is_empty(Children) then
|
|
% There won't be any .int0 files to install.
|
|
ExtExtDirs0 = []
|
|
else
|
|
ExtExtDirs0 = [{ext_cur_ngs(ext_cur_ngs_int_int0), "int0s"}]
|
|
),
|
|
globals.get_any_intermod(Globals, AnyIntermod),
|
|
(
|
|
AnyIntermod = yes,
|
|
% XXX LEGACY
|
|
ExtOpt = ext_cur_ngs_gs_max_ngs(
|
|
ext_cur_ngs_gs_max_ngs_legacy_opt_plain),
|
|
ExtExtDirs1 = [{ExtOpt, "opts"} | ExtExtDirs0]
|
|
;
|
|
AnyIntermod = no,
|
|
ExtExtDirs1 = ExtExtDirs0
|
|
),
|
|
ExtExtDirs =
|
|
[{ext_cur_ngs(ext_cur_ngs_int_int1), "ints"},
|
|
{ext_cur_ngs(ext_cur_ngs_int_int2), "int2s"},
|
|
{ext_cur_ngs(ext_cur_ngs_int_int3), "int3s"},
|
|
{ext_cur_ngs(ext_cur_ngs_misc_module_dep), "module_deps"}
|
|
| ExtExtDirs1],
|
|
globals.lookup_string_option(Globals, install_prefix, Prefix),
|
|
LibDir = Prefix / "lib" / "mercury",
|
|
list.foldl2(
|
|
legacy_install_subdir_file(ProgressStream, Globals, NgsLibDirMap,
|
|
LibDir / "ints", ModuleName),
|
|
ExtExtDirs, !Succeeded, !IO),
|
|
|
|
globals.get_target(Globals, Target),
|
|
(
|
|
Target = target_c,
|
|
% `.mh' files are (were) only generated for modules containing
|
|
% `:- pragma foreign_export' declarations.
|
|
% But `.mh' files are expected by Mmake so always generate them,
|
|
% otherwise there is trouble using libraries installed by
|
|
% `mmc --make' with Mmake.
|
|
% XXX If we ever phase out mmake we could revert this behaviour.
|
|
% XXX Should we test
|
|
% ModuleDepInfo ^ contains_foreign_export
|
|
% = contains_foreign_export?
|
|
ExtMh = ext_cur_pgs_max_cur(ext_cur_pgs_max_cur_mh),
|
|
% XXX LEGACY
|
|
module_name_to_file_name(Globals, $pred, ExtMh,
|
|
ModuleName, FileName, _FileNameProposed),
|
|
install_file(ProgressStream, Globals, FileName, LibDir / "inc",
|
|
!Succeeded, !IO),
|
|
|
|
% This is needed so that the file will be found in Mmake's VPATH.
|
|
legacy_install_subdir_file(ProgressStream, Globals, NgsLibDirMap,
|
|
LibDir / "ints", ModuleName, {ExtMh, "mhs"}, !Succeeded, !IO)
|
|
;
|
|
( Target = target_java
|
|
; Target = target_csharp
|
|
)
|
|
)
|
|
;
|
|
MaybeModuleDepInfo = no_module_dep_info,
|
|
!:Succeeded = did_not_succeed
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pred legacy_install_extra_headers(io.text_output_stream::in, globals::in,
|
|
maybe_succeeded::in, maybe_succeeded::out, io::di, io::uo) is det.
|
|
|
|
legacy_install_extra_headers(ProgressStream, Globals, !Succeeded, !IO) :-
|
|
globals.lookup_accumulating_option(Globals, extra_library_header,
|
|
ExtraHdrs),
|
|
globals.lookup_string_option(Globals, install_prefix, Prefix),
|
|
IncDir = Prefix / "lib" / "mercury" / "inc",
|
|
list.foldl2(install_file_to(ProgressStream, Globals, IncDir),
|
|
ExtraHdrs, !Succeeded, !IO).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% The code to install non-grade-specific files for the PROPOSED install
|
|
% directory structure.
|
|
%
|
|
|
|
:- pred proposed_install_library_non_grade_specific_files(
|
|
io.text_output_stream::in, globals::in,
|
|
list(module_name)::in, maybe_succeeded::out,
|
|
make_info::in, make_info::out, io::di, io::uo) is det.
|
|
|
|
proposed_install_library_non_grade_specific_files(ProgressStream, Globals,
|
|
AllModuleNames, !:Succeeded, !Info, !IO) :-
|
|
gather_module_dep_infos(ProgressStream, Globals, AllModuleNames,
|
|
ModulesWithChildren, DepInfoSucceded, !Info, !IO),
|
|
(
|
|
DepInfoSucceded = did_not_succeed,
|
|
!:Succeeded = did_not_succeed
|
|
;
|
|
DepInfoSucceded = succeeded,
|
|
!:Succeeded = succeeded,
|
|
|
|
globals.lookup_string_option(Globals, install_prefix, Prefix0),
|
|
Prefix = Prefix0 / "MercurySystem",
|
|
|
|
make_dir_handle_any_error(ProgressStream, Prefix,
|
|
MakePrefixDirSucceeded, !IO),
|
|
(
|
|
MakePrefixDirSucceeded = did_not_succeed
|
|
;
|
|
MakePrefixDirSucceeded = succeeded,
|
|
ExtInt0 = ext_cur_ngs(ext_cur_ngs_int_int0) : ext_cur_ngs_ns,
|
|
ExtInt1 = ext_cur_ngs(ext_cur_ngs_int_int1) : ext_cur_ngs_ns,
|
|
ExtInt2 = ext_cur_ngs(ext_cur_ngs_int_int2) : ext_cur_ngs_ns,
|
|
ExtInt3 = ext_cur_ngs(ext_cur_ngs_int_int3) : ext_cur_ngs_ns,
|
|
proposed_install_all_ngs_files(ProgressStream, Globals, Prefix,
|
|
ExtInt0, ModulesWithChildren, !Succeeded, !IO),
|
|
proposed_install_all_ngs_files(ProgressStream, Globals, Prefix,
|
|
ExtInt1, AllModuleNames, !Succeeded, !IO),
|
|
proposed_install_all_ngs_files(ProgressStream, Globals, Prefix,
|
|
ExtInt2, AllModuleNames, !Succeeded, !IO),
|
|
proposed_install_all_ngs_files(ProgressStream, Globals, Prefix,
|
|
ExtInt3, AllModuleNames, !Succeeded, !IO),
|
|
|
|
% XXX There is a potential problem here. We install .mh files,
|
|
% which are not-grade-specific beyond being C-specific, if
|
|
% the *current* grade targets C. However, if
|
|
%
|
|
% - the current grade targets a language *other than C*, but
|
|
% - some other libgrade *does target C*,
|
|
%
|
|
% then no .mh file will get installed.
|
|
%
|
|
% We could avoid this by making .mh files grade-specific
|
|
% (which, in a way, they are), but that would be inconvenient
|
|
% for users, since #include statements for these .mh files
|
|
% in their handwritten C code would have to be steered *somehow*
|
|
% to the directory containing that .mh file *some* installed
|
|
% C grade. That may, or may not, be the current grade, but
|
|
% having to keep track of *two* grades, not one, in the build
|
|
% infrastructure would be annoying.
|
|
%
|
|
% The right solution is probably
|
|
%
|
|
% - to wrap a "do this only if not already done" wrapper around
|
|
% this code,
|
|
% - to put that wrapped code in a separate predicate,
|
|
% - and invoke that predicate both here and in the code that
|
|
% installs the grade-specific files.
|
|
globals.get_target(Globals, Target),
|
|
(
|
|
Target = target_c,
|
|
% Once upon a time, we generated `.mh' files only for modules
|
|
% containing `:- pragma foreign_export' declarations.
|
|
% (See ModuleDepInfo ^ contains_foreign_export.)
|
|
% But `.mh' files are expected by Mmake, so now we always
|
|
% generate them. If we didn't, mmake would have trouble
|
|
% when using libraries installed by `mmc --make'.
|
|
ExtMh = ext_cur_pgs_max_cur(ext_cur_pgs_max_cur_mh),
|
|
proposed_install_all_ngs_files(ProgressStream, Globals, Prefix,
|
|
ExtMh, AllModuleNames, !Succeeded, !IO),
|
|
|
|
proposed_install_extra_headers(ProgressStream, Globals, Prefix,
|
|
!Succeeded, !IO)
|
|
;
|
|
( Target = target_java
|
|
; Target = target_csharp
|
|
)
|
|
)
|
|
)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- type ext_cur_ngs_ns =< ext
|
|
---> ext_cur_ngs(ext_cur_ngs)
|
|
; ext_cur_pgs_max_cur(ext_cur_pgs_max_cur).
|
|
|
|
:- pred proposed_install_all_ngs_files(io.text_output_stream::in, globals::in,
|
|
string::in, ext_cur_ngs_ns::in, list(module_name)::in,
|
|
maybe_succeeded::in, maybe_succeeded::out, io::di, io::uo) is det.
|
|
|
|
proposed_install_all_ngs_files(ProgressStream, Globals, Prefix,
|
|
Ext, ModuleNames, !Succeeded, !IO) :-
|
|
(
|
|
Ext = ext_cur_ngs(ExtNgs),
|
|
ext_cur_ngs_extension_dir(ExtNgs, _, ExtDirName)
|
|
;
|
|
Ext = ext_cur_pgs_max_cur(ExtPgsMaxCur),
|
|
ext_cur_pgs_max_cur_extension_dir(ExtPgsMaxCur, _, ExtDirName)
|
|
),
|
|
|
|
InstallDir = Prefix / ExtDirName,
|
|
make_dir_handle_any_error(ProgressStream, InstallDir,
|
|
MakeInstallDirSucceeded, !IO),
|
|
(
|
|
MakeInstallDirSucceeded = did_not_succeed
|
|
;
|
|
MakeInstallDirSucceeded = succeeded,
|
|
GenExt = coerce(Ext),
|
|
list.map(module_name_to_workspace_file_name(Globals, GenExt),
|
|
ModuleNames, FileNames),
|
|
install_files_to(ProgressStream, Globals, InstallDir,
|
|
FileNames, !Succeeded, !IO)
|
|
).
|
|
|
|
:- pred proposed_install_extra_headers(io.text_output_stream::in, globals::in,
|
|
string::in,
|
|
maybe_succeeded::in, maybe_succeeded::out, io::di, io::uo) is det.
|
|
|
|
proposed_install_extra_headers(ProgressStream, Globals, Prefix,
|
|
!Succeeded, !IO) :-
|
|
globals.lookup_accumulating_option(Globals, extra_library_header,
|
|
ExtraHdrFileNames),
|
|
% We could install extra headers to a specialized directory,
|
|
% or we could install them to the directory to which we install
|
|
% either .mh or .mih files. Since .mih files are internal details
|
|
% of the Mercury implementation, that choice looks wrong. The other two
|
|
% are definitely defensible. The code below chooses the second alternative,
|
|
% installing to the directory containing .mh files. The main advantage
|
|
% of this choice is that it avoids the extra complication that an extra
|
|
% directory to search for would mean for invoking the C compiler.
|
|
ExtPgsMaxCur = ext_cur_pgs_max_cur_mh,
|
|
ext_cur_pgs_max_cur_extension_dir(ExtPgsMaxCur, _, ExtDirName),
|
|
|
|
InstallDir = Prefix / ExtDirName,
|
|
make_dir_handle_any_error(ProgressStream, InstallDir,
|
|
MakeInstallDirSucceeded, !IO),
|
|
(
|
|
MakeInstallDirSucceeded = did_not_succeed
|
|
;
|
|
MakeInstallDirSucceeded = succeeded,
|
|
install_files_to(ProgressStream, Globals, InstallDir,
|
|
ExtraHdrFileNames, !Succeeded, !IO)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% The code to install grade-specific files for both the LEGACY
|
|
% and the (eventually) PROPOSED install directory structure.
|
|
%
|
|
|
|
:- pred install_library_grade_specific_files_for_all_libgrades(
|
|
io.text_output_stream::in, globals::in, libdir_map::in,
|
|
module_name::in, list(module_name)::in,
|
|
maybe_succeeded::in, maybe_succeeded::out,
|
|
make_info::in, make_info::out, io::di, io::uo) is det.
|
|
|
|
install_library_grade_specific_files_for_all_libgrades(ProgressStream,
|
|
Globals, NgsLibDirMap, MainModuleName, AllModuleNames,
|
|
!Succeeded, !Info, !IO) :-
|
|
% The library is already built in the current grade; we just need to
|
|
% install it. For all other grades, we must build the library first
|
|
% in that grade before we can install it.
|
|
globals.get_grade_dir(Globals, CurGrade),
|
|
install_library_grade_specific_files_for_grade(ProgressStream, Globals,
|
|
NgsLibDirMap, CurGrade, MainModuleName, AllModuleNames,
|
|
!Succeeded, !Info, !IO),
|
|
|
|
% XXX With Mmake, LIBGRADES is target-specific; with this code in
|
|
% mmc --make, it isn't.
|
|
globals.lookup_accumulating_option(Globals, library_install_grades,
|
|
LibGrades),
|
|
NonCurLibGrades = list.delete_all(LibGrades, CurGrade),
|
|
KeepGoing = make_info_get_keep_going(!.Info),
|
|
setup_make_and_install_grade_specific_files_for_grades(ProgressStream,
|
|
KeepGoing, Globals, NgsLibDirMap, MainModuleName, AllModuleNames,
|
|
NonCurLibGrades, !Succeeded, !Info, !IO).
|
|
|
|
:- pred setup_make_and_install_grade_specific_files_for_grades(
|
|
io.text_output_stream::in, maybe_keep_going::in, globals::in,
|
|
libdir_map::in, module_name::in, list(module_name)::in, list(string)::in,
|
|
maybe_succeeded::in, maybe_succeeded::out,
|
|
make_info::in, make_info::out, io::di, io::uo) is det.
|
|
|
|
setup_make_and_install_grade_specific_files_for_grades(_, _, _, _, _, _, [],
|
|
!Succeeded, !Info, !IO).
|
|
setup_make_and_install_grade_specific_files_for_grades(ProgressStream,
|
|
KeepGoing, Globals, NgsLibDirMap, MainModuleName, AllModuleNames,
|
|
[Grade | Grades], !Succeeded, !Info, !IO) :-
|
|
should_we_stop_or_continue(KeepGoing, !.Succeeded, StopOrContinue,
|
|
!Succeeded),
|
|
(
|
|
StopOrContinue = soc_stop
|
|
;
|
|
StopOrContinue = soc_continue,
|
|
setup_make_and_install_grade_specific_files_for_grade(ProgressStream,
|
|
Globals, NgsLibDirMap, MainModuleName, AllModuleNames,
|
|
Grade, !Succeeded, !Info, !IO),
|
|
setup_make_and_install_grade_specific_files_for_grades(ProgressStream,
|
|
KeepGoing, Globals, NgsLibDirMap, MainModuleName, AllModuleNames,
|
|
Grades, !Succeeded, !Info, !IO)
|
|
).
|
|
|
|
% This predicate sets things up for
|
|
%
|
|
% - first making the library in the given grade,
|
|
% - and then installing that library,
|
|
%
|
|
% and then invokes make_and_install_grade_specific_files_for_grades
|
|
% to actually do both of those actions.
|
|
%.
|
|
:- pred setup_make_and_install_grade_specific_files_for_grade(
|
|
io.text_output_stream::in, globals::in, libdir_map::in,
|
|
module_name::in, list(module_name)::in, string::in,
|
|
maybe_succeeded::in, maybe_succeeded::out,
|
|
make_info::in, make_info::out, io::di, io::uo) is det.
|
|
|
|
setup_make_and_install_grade_specific_files_for_grade(ProgressStream, Globals,
|
|
NgsLibDirMap, MainModuleName, AllModuleNames, Grade,
|
|
!Succeeded, !Info, !IO) :-
|
|
% Only remove grade-dependent files after installing if
|
|
% --use-grade-subdirs is not specified by the user.
|
|
globals.get_subdir_setting(Globals, SubDirSetting),
|
|
(
|
|
( SubDirSetting = use_cur_dir
|
|
; SubDirSetting = use_cur_ngs_subdir
|
|
),
|
|
CleanAfter = yes
|
|
;
|
|
SubDirSetting = use_cur_ngs_gs_subdir,
|
|
CleanAfter = no
|
|
),
|
|
|
|
Params0 = make_info_get_compiler_params(!.Info),
|
|
Params0 = compiler_params(EnvOptFileVariables, EnvVarArgs, OptionArgs0),
|
|
% Set up so that grade-dependent files for the current grade
|
|
% do not overwrite the files for the default grade.
|
|
OptionArgs = OptionArgs0 ++ ["--grade", Grade, "--use-grade-subdirs"],
|
|
Params = compiler_params(EnvOptFileVariables, EnvVarArgs, OptionArgs),
|
|
|
|
verbose_make_two_part_msg(Globals, "Installing grade", Grade, InstallMsg),
|
|
maybe_write_msg(ProgressStream, InstallMsg, !IO),
|
|
|
|
lookup_mmc_options(EnvOptFileVariables, MaybeMCFlags),
|
|
(
|
|
MaybeMCFlags = ok1(MCFlags),
|
|
get_default_options(Globals, DefaultOptionTable),
|
|
MaybeStdLibGrades = make_info_get_maybe_stdlib_grades(!.Info),
|
|
AllFlags = MCFlags ++ EnvVarArgs ++ OptionArgs,
|
|
lookup_mercury_stdlib_dir(EnvOptFileVariables,
|
|
MaybeEnvOptFileStdLibDirs),
|
|
handle_given_options(ProgressStream, DefaultOptionTable,
|
|
MaybeStdLibGrades, MaybeEnvOptFileStdLibDirs, AllFlags, _, _,
|
|
OptionsSpecs, LibGlobals, !IO)
|
|
;
|
|
MaybeMCFlags = error1(LookupSpecs),
|
|
write_error_specs(ProgressStream, Globals, LookupSpecs, !IO),
|
|
% Errors should have been caught before.
|
|
unexpected($pred, "bad DEFAULT_MCFLAGS")
|
|
),
|
|
|
|
(
|
|
OptionsSpecs = [_ | _],
|
|
usage_errors(ProgressStream, Globals, OptionsSpecs, !IO),
|
|
!:Succeeded = did_not_succeed
|
|
;
|
|
OptionsSpecs = [],
|
|
|
|
% Remove the grade-dependent targets from the status map
|
|
% (we need to rebuild them in the new grade).
|
|
%
|
|
% NOTE This code was disabled from 2008 jul 14 until 2023 dec 12
|
|
% due to a bug in version_hash_table.delete. That bug, which was
|
|
% due to the holes left by deletes in open addressing probe sequences,
|
|
% was fixed by switching to separate chaining on 2009 mar 26.
|
|
% The replacement code was
|
|
%
|
|
% StatusMap = version_hash_table.init_default(target_id_hash)
|
|
%
|
|
% NOTE that each delete made by remove_target_file_if_grade_dependent
|
|
% will create a new version_hash_table, even though, with the exception
|
|
% of the last one, none of them can never be referred to again.
|
|
% It is not clear whether keeping all non-grade-dependent files'
|
|
% statuses in the map makes paying this cost worthwhile.
|
|
%
|
|
% XXX One obvious solution to this problem would be to
|
|
% - convert StatusMap0 to an assoc list;
|
|
% - delete all grade dependent files' entries from this assoc list;
|
|
% - then construct a new version hash table from the result.
|
|
StatusMap0 = make_info_get_target_status_map(!.Info),
|
|
version_hash_table.fold(remove_target_file_if_grade_dependent,
|
|
StatusMap0, StatusMap0, StatusMap),
|
|
|
|
make_info_set_target_status_map(StatusMap, !Info),
|
|
make_info_set_compiler_params(Params, !Info),
|
|
|
|
% Reset the target file timestamp cache, as the information it contains
|
|
% is not valid for the changed grade and grade-subdir setting.
|
|
make_info_set_target_file_timestamp_map(init_target_file_timestamp_map,
|
|
!Info),
|
|
|
|
% We build the library in the new grade in a separate process
|
|
% to make it easier to stop and clean up on an interrupt.
|
|
globals.lookup_bool_option(LibGlobals, very_verbose, VeryVerbose),
|
|
setup_checking_for_interrupt(Cookie, !IO),
|
|
call_in_forked_process(
|
|
make_and_install_grade_specific_files_for_grades(ProgressStream,
|
|
LibGlobals, NgsLibDirMap, MainModuleName, AllModuleNames,
|
|
!.Info, CleanAfter),
|
|
Succeeded0, !IO),
|
|
CleanupPred = maybe_make_grade_clean(ProgressStream, LibGlobals,
|
|
CleanAfter, MainModuleName, AllModuleNames),
|
|
teardown_checking_for_interrupt(VeryVerbose, Cookie, CleanupPred,
|
|
Succeeded0, Succeeded1, !Info, !IO),
|
|
!:Succeeded = !.Succeeded `and` Succeeded1
|
|
).
|
|
|
|
:- pred make_and_install_grade_specific_files_for_grades(
|
|
io.text_output_stream::in, globals::in, libdir_map::in,
|
|
module_name::in, list(module_name)::in, make_info::in, bool::in,
|
|
maybe_succeeded::out, io::di, io::uo) is det.
|
|
|
|
make_and_install_grade_specific_files_for_grades(ProgressStream, Globals,
|
|
NgsLibDirMap, MainModuleName, AllModuleNames, !.Info, CleanAfter,
|
|
Succeeded, !IO) :-
|
|
% This is the "make" part ...
|
|
make_misc_target(ProgressStream, Globals,
|
|
MainModuleName - misc_target_build_library, LibSucceeded,
|
|
!Info, [], Specs, !IO),
|
|
(
|
|
LibSucceeded = succeeded,
|
|
% ... and this is the "install" part.
|
|
globals.get_grade_dir(Globals, GradeDir),
|
|
install_library_grade_specific_files_for_grade(ProgressStream, Globals,
|
|
NgsLibDirMap, GradeDir, MainModuleName, AllModuleNames,
|
|
succeeded, Succeeded, !Info, !IO),
|
|
maybe_make_grade_clean(ProgressStream, Globals, CleanAfter,
|
|
MainModuleName, AllModuleNames, !.Info, _Info, !IO)
|
|
;
|
|
LibSucceeded = did_not_succeed,
|
|
% XXX MAKE_STREAM
|
|
io.output_stream(ErrorStream, !IO),
|
|
write_error_specs(ErrorStream, Globals, Specs, !IO),
|
|
Succeeded = did_not_succeed
|
|
).
|
|
|
|
% Install the `.a', `.so', `.jar', `.opt' and `.mih' files for
|
|
% the current grade.
|
|
%
|
|
% XXX document the others ...
|
|
%
|
|
:- pred install_library_grade_specific_files_for_grade(
|
|
io.text_output_stream::in, globals::in, libdir_map::in, string::in,
|
|
module_name::in, list(module_name)::in,
|
|
maybe_succeeded::in, maybe_succeeded::out,
|
|
make_info::in, make_info::out, io::di, io::uo) is det.
|
|
|
|
install_library_grade_specific_files_for_grade(ProgressStream,
|
|
Globals, NgsLibDirMap, GradeDir, MainModuleName, AllModuleNames,
|
|
!Succeeded, !Info, !IO) :-
|
|
legacy_install_library_grade_specific_files_for_grade(ProgressStream,
|
|
Globals, NgsLibDirMap, GradeDir, MainModuleName, AllModuleNames,
|
|
!Succeeded, !Info, !IO),
|
|
globals.lookup_bool_option(Globals, experiment4, InstallProposed),
|
|
(
|
|
InstallProposed = no
|
|
;
|
|
InstallProposed = yes,
|
|
proposed_install_library_grade_specific_files_for_grade(ProgressStream,
|
|
Globals, GradeDir, MainModuleName, AllModuleNames,
|
|
!Succeeded, !Info, !IO)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% The code to install grade-specific files for the LEGACY install
|
|
% directory structure.
|
|
%
|
|
|
|
:- pred legacy_install_library_grade_specific_files_for_grade(
|
|
io.text_output_stream::in, globals::in, libdir_map::in, string::in,
|
|
module_name::in, list(module_name)::in,
|
|
maybe_succeeded::in, maybe_succeeded::out,
|
|
make_info::in, make_info::out, io::di, io::uo) is det.
|
|
|
|
legacy_install_library_grade_specific_files_for_grade(ProgressStream,
|
|
Globals, NgsLibDirMap, GradeDir, MainModuleName, AllModuleNames,
|
|
!Succeeded, !Info, !IO) :-
|
|
% This creates *some* of the directories into which we install
|
|
% grade-specific files, but not all; some are created by the calls
|
|
% to module_name_to_file_name_create_dirs below.
|
|
legacy_make_grade_specific_install_dirs(ProgressStream, Globals, GradeDir,
|
|
DirSucceeded, GsLibDirMap, !IO),
|
|
(
|
|
DirSucceeded = succeeded,
|
|
globals.get_target(Globals, Target),
|
|
get_std_grade_specific_install_lib_dir(Globals, GradeDir, GradeLibDir),
|
|
(
|
|
Target = target_csharp,
|
|
ExtDll = ext_cur_gs(ext_cur_gs_lib_cil_dll),
|
|
% XXX LEGACY
|
|
module_name_to_file_name_create_dirs(Globals, $pred, ExtDll,
|
|
MainModuleName, DllFileName, _DllFileNameProposed, !IO),
|
|
install_file(ProgressStream, Globals, DllFileName, GradeLibDir,
|
|
!Succeeded, !IO)
|
|
;
|
|
Target = target_java,
|
|
ExtJar = ext_cur_gs(ext_cur_gs_lib_jar),
|
|
% XXX LEGACY
|
|
module_name_to_file_name_create_dirs(Globals, $pred, ExtJar,
|
|
MainModuleName, JarFileName, _JarFileNameProposed, !IO),
|
|
install_file(ProgressStream, Globals, JarFileName, GradeLibDir,
|
|
!Succeeded, !IO)
|
|
;
|
|
Target = target_c,
|
|
ExtA = ext_cur_gas(ext_cur_gas_lib_lib_opt),
|
|
ExtSo = ext_cur_gas(ext_cur_gas_lib_sh_lib_opt),
|
|
% XXX LEGACY
|
|
module_name_to_lib_file_name_create_dirs(Globals, $pred,
|
|
"lib", ExtA, MainModuleName,
|
|
StaticLibFileName, _StaticLibFileNameProposed, !IO),
|
|
module_name_to_lib_file_name_create_dirs(Globals, $pred,
|
|
"lib", ExtSo, MainModuleName,
|
|
SharedLibFileName, _SharedLibFileNameProposed, !IO),
|
|
legacy_maybe_install_static_or_dynamic_archive(ProgressStream,
|
|
Globals, sos_static, StaticLibFileName, GradeLibDir,
|
|
!Succeeded, !IO),
|
|
( if StaticLibFileName = SharedLibFileName then
|
|
true
|
|
else
|
|
legacy_maybe_install_static_or_dynamic_archive(ProgressStream,
|
|
Globals, sos_shared, SharedLibFileName, GradeLibDir,
|
|
!Succeeded, !IO)
|
|
),
|
|
legacy_install_grade_init(ProgressStream, Globals, GradeDir,
|
|
MainModuleName, !Succeeded, !IO)
|
|
),
|
|
|
|
list.foldl3(
|
|
legacy_install_grade_ints_and_headers(ProgressStream, Globals,
|
|
NgsLibDirMap, GsLibDirMap, GradeDir),
|
|
AllModuleNames, !Succeeded, !Info, !IO)
|
|
;
|
|
DirSucceeded = did_not_succeed,
|
|
!:Succeeded = did_not_succeed
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pred legacy_make_grade_specific_install_dirs(io.text_output_stream::in,
|
|
globals::in, string::in, maybe_succeeded::out, libdir_map::out,
|
|
io::di, io::uo) is det.
|
|
|
|
legacy_make_grade_specific_install_dirs(ProgressStream, Globals, GradeDir,
|
|
!:DirSucceeded, !:GsLibDirMap, !IO) :-
|
|
!:DirSucceeded = succeeded,
|
|
globals.lookup_string_option(Globals, install_prefix, Prefix),
|
|
LibDir = Prefix / "lib" / "mercury",
|
|
|
|
GradeIncSubDir = LibDir / "lib" / GradeDir / "inc",
|
|
GradeIntsSubDir = LibDir / "ints" / GradeDir,
|
|
GradeModuleSubDir = LibDir / "modules" / GradeDir,
|
|
|
|
legacy_make_nonext_dir(ProgressStream, GradeIncSubDir / "Mercury",
|
|
!DirSucceeded, !IO),
|
|
legacy_make_nonext_dir(ProgressStream, GradeIntsSubDir / "Mercury",
|
|
!DirSucceeded, !IO),
|
|
legacy_make_nonext_dir(ProgressStream, GradeModuleSubDir,
|
|
!DirSucceeded, !IO),
|
|
|
|
map.init(!:GsLibDirMap),
|
|
|
|
globals.lookup_bool_option(Globals, use_symlinks, UseSymLinks),
|
|
(
|
|
UseSymLinks = yes,
|
|
% XXX This code seems strange, because code using mmc --make
|
|
% with --use-grade-subdirs should look for grade-specific files *only*
|
|
% in LibDir / "ints" / GradeDir / "Mercury" / ExtDir, and *never*
|
|
% in LibDir / "ints" / GradeDir.
|
|
%
|
|
% I (zs) can think of two possible reasons for using symlinks here.
|
|
% One is that the original author of this code for creating the
|
|
% directories for grade-specific files reused the code for
|
|
% non-grade-specific files, even though it was not designed for this
|
|
% purpose. The other is that this reuse also made the grade-specific
|
|
% install directories sort-of isomorphic to the non-grade-specific
|
|
% install directories, which allows code NOT using either mmc --make
|
|
% or --use-grade-subdirs to use the same VPATH mechanism to look
|
|
% inside both, just by specifying the appropriate starting path name
|
|
% for each. (The "sort-of" is there because the non-grade-specific
|
|
% install directories *contain* the grade-specific ones.)
|
|
legacy_make_ngs_dir_symlink_to_cur(ProgressStream, GradeIncSubDir,
|
|
"mihs", !DirSucceeded, !GsLibDirMap, !IO),
|
|
list.foldl3(
|
|
legacy_make_ngs_dir_symlink_to_cur(ProgressStream,
|
|
GradeIntsSubDir),
|
|
["opts", "analyses"],
|
|
!DirSucceeded, !GsLibDirMap, !IO)
|
|
;
|
|
UseSymLinks = no,
|
|
legacy_make_ngs_dir(ProgressStream, GradeIncSubDir, "mihs",
|
|
!DirSucceeded, !GsLibDirMap, !IO),
|
|
legacy_make_ngs_dir(ProgressStream, GradeIntsSubDir, "opts",
|
|
!DirSucceeded, !GsLibDirMap, !IO),
|
|
legacy_make_ngs_dir(ProgressStream, GradeIntsSubDir, "analyses",
|
|
!DirSucceeded, !GsLibDirMap, !IO)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
% Install the `.init' file for the current grade.
|
|
%
|
|
:- pred legacy_install_grade_init(io.text_output_stream::in, globals::in,
|
|
string::in, module_name::in, maybe_succeeded::in, maybe_succeeded::out,
|
|
io::di, io::uo) is det.
|
|
|
|
legacy_install_grade_init(ProgressStream, Globals, GradeDir, MainModuleName,
|
|
!Succeeded, !IO) :-
|
|
% XXX Should we generalize get_std_grade_specific_install_lib_dir
|
|
% to include this s/lib/modules/ version?
|
|
globals.lookup_string_option(Globals, install_prefix, Prefix),
|
|
GradeModulesDir = Prefix / "lib" / "mercury" / "modules" / GradeDir,
|
|
% XXX LEGACY
|
|
module_name_to_file_name(Globals, $pred, ext_cur_gs(ext_cur_gs_lib_init),
|
|
MainModuleName, InitFileName, _InitFileNameProposed),
|
|
install_file(ProgressStream, Globals, InitFileName, GradeModulesDir,
|
|
!Succeeded, !IO).
|
|
|
|
%---------------------%
|
|
|
|
% Install the `.opt', `.analysis' and `.mih' files for the current grade.
|
|
%
|
|
:- pred legacy_install_grade_ints_and_headers(io.text_output_stream::in,
|
|
globals::in, libdir_map::in, libdir_map::in, string::in, module_name::in,
|
|
maybe_succeeded::in, maybe_succeeded::out,
|
|
make_info::in, make_info::out, io::di, io::uo) is det.
|
|
|
|
legacy_install_grade_ints_and_headers(ProgressStream, Globals,
|
|
NgsLibDirMap, GsLibDirMap, GradeDir, ModuleName,
|
|
!Succeeded, !Info, !IO) :-
|
|
get_maybe_module_dep_info(ProgressStream, Globals,
|
|
ModuleName, MaybeModuleDepInfo, !Info, !IO),
|
|
(
|
|
MaybeModuleDepInfo = some_module_dep_info(_ModuleDepInfo),
|
|
|
|
globals.lookup_string_option(Globals, install_prefix, Prefix),
|
|
LibDir = Prefix / "lib" / "mercury",
|
|
|
|
% NOTE Before our ancestor
|
|
% install_library_grade_specific_files_for_grade gets invoked,
|
|
% the grade-specific components of Globals, including Target and
|
|
% HighLevelCode, will have been set up to reflect the grade
|
|
% that we are installing.
|
|
globals.get_target(Globals, Target),
|
|
globals.lookup_bool_option(Globals, highlevel_code, HighLevelCode),
|
|
( if
|
|
Target = target_c,
|
|
HighLevelCode = yes
|
|
then
|
|
GradeIncDir = LibDir / "lib" / GradeDir / "inc",
|
|
ExtMih = ext_cur_ngs_gs_max_cur(ext_cur_ngs_gs_max_cur_mih),
|
|
legacy_install_subdir_file(ProgressStream, Globals, GsLibDirMap,
|
|
GradeIncDir, ModuleName, {ExtMih, "mihs"}, !Succeeded, !IO),
|
|
|
|
% This is needed so that the file will be found in Mmake's VPATH.
|
|
%
|
|
% XXX BUG Why are we installing to a NON-GRADE-SPECIFIC directory
|
|
% in a predicate that does installs of GRADE-SPECIFIC files?
|
|
% Any installs done by this code for one grade will be overwritten
|
|
% by the install done by the next grade.
|
|
IntsDir = LibDir / "ints",
|
|
legacy_install_subdir_file(ProgressStream, Globals, NgsLibDirMap,
|
|
IntsDir, ModuleName, {ExtMih, "mihs"}, !Succeeded, !IO)
|
|
else
|
|
true
|
|
),
|
|
|
|
GradeIntsDir = LibDir / "ints" / GradeDir,
|
|
globals.get_any_intermod(Globals, AnyIntermod),
|
|
(
|
|
AnyIntermod = yes,
|
|
% XXX LEGACY
|
|
ExtOpt = ext_cur_ngs_gs_max_ngs(
|
|
ext_cur_ngs_gs_max_ngs_legacy_opt_plain),
|
|
legacy_install_subdir_file(ProgressStream, Globals, GsLibDirMap,
|
|
GradeIntsDir, ModuleName, {ExtOpt, "opts"}, !Succeeded, !IO)
|
|
;
|
|
AnyIntermod = no
|
|
),
|
|
globals.lookup_bool_option(Globals, intermodule_analysis,
|
|
IntermodAnalysis),
|
|
(
|
|
IntermodAnalysis = yes,
|
|
ExtAn = ext_cur_ngs_gs_max_ngs(ext_cur_ngs_gs_max_ngs_an_analysis),
|
|
legacy_install_subdir_file(ProgressStream, Globals, GsLibDirMap,
|
|
GradeIntsDir, ModuleName, {ExtAn, "analyses"}, !Succeeded, !IO)
|
|
;
|
|
IntermodAnalysis = no
|
|
)
|
|
;
|
|
MaybeModuleDepInfo = no_module_dep_info,
|
|
!:Succeeded = did_not_succeed
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% The code to install grade-specific files for the PROPOSED install
|
|
% directory structure.
|
|
%
|
|
|
|
:- pred proposed_install_library_grade_specific_files_for_grade(
|
|
io.text_output_stream::in, globals::in, string::in,
|
|
module_name::in, list(module_name)::in,
|
|
maybe_succeeded::in, maybe_succeeded::out,
|
|
make_info::in, make_info::out, io::di, io::uo) is det.
|
|
|
|
proposed_install_library_grade_specific_files_for_grade(ProgressStream,
|
|
Globals, Grade, MainModuleName, AllModuleNames,
|
|
!Succeeded, !Info, !IO) :-
|
|
gather_module_dep_infos(ProgressStream, Globals, AllModuleNames,
|
|
_ModulesWithChildren, Succeeded, !Info, !IO),
|
|
(
|
|
Succeeded = did_not_succeed,
|
|
!:Succeeded = did_not_succeed
|
|
;
|
|
Succeeded = succeeded,
|
|
|
|
globals.lookup_string_option(Globals, install_prefix, Prefix0),
|
|
Prefix = Prefix0 / "MercurySystem",
|
|
|
|
% This file type *is* be grade-specific, and should be listed
|
|
% as such.
|
|
ExtMD = ext_cur_ngs(ext_cur_ngs_misc_module_dep),
|
|
proposed_install_all_gs_files(ProgressStream, Globals, Prefix, Grade,
|
|
ExtMD, AllModuleNames, !Succeeded, !IO),
|
|
|
|
globals.get_any_intermod(Globals, AnyIntermod),
|
|
(
|
|
AnyIntermod = no
|
|
;
|
|
AnyIntermod = yes,
|
|
ExtOpt = ext_cur_ngs_gs(ext_cur_ngs_gs_proposed_opt_plain),
|
|
proposed_install_all_gs_files(ProgressStream, Globals,
|
|
Prefix, Grade, ExtOpt, AllModuleNames, !Succeeded, !IO)
|
|
),
|
|
|
|
globals.lookup_bool_option(Globals, intermodule_analysis,
|
|
IntermodAnalysis),
|
|
(
|
|
IntermodAnalysis = no
|
|
;
|
|
IntermodAnalysis = yes,
|
|
ExtAn = ext_cur_ngs_gs_max_ngs(ext_cur_ngs_gs_max_ngs_an_analysis),
|
|
proposed_install_all_gs_files(ProgressStream, Globals,
|
|
Prefix, Grade, ExtAn, AllModuleNames, !Succeeded, !IO)
|
|
),
|
|
|
|
globals.get_target(Globals, Target),
|
|
(
|
|
Target = target_c,
|
|
proposed_install_library_grade_specific_files_for_grade_c(
|
|
ProgressStream, Globals, Prefix, Grade,
|
|
MainModuleName, AllModuleNames, !Succeeded, !IO)
|
|
;
|
|
Target = target_java,
|
|
proposed_install_library_grade_specific_files_for_grade_java(
|
|
ProgressStream, Globals, Prefix, Grade,
|
|
MainModuleName, AllModuleNames, !Succeeded, !IO)
|
|
;
|
|
Target = target_csharp,
|
|
proposed_install_library_grade_specific_files_for_grade_csharp(
|
|
ProgressStream, Globals, Prefix, Grade,
|
|
MainModuleName, AllModuleNames, !Succeeded, !IO)
|
|
)
|
|
).
|
|
|
|
:- pred proposed_install_library_grade_specific_files_for_grade_c(
|
|
io.text_output_stream::in, globals::in, string::in, string::in,
|
|
module_name::in, list(module_name)::in,
|
|
maybe_succeeded::in, maybe_succeeded::out, io::di, io::uo) is det.
|
|
|
|
proposed_install_library_grade_specific_files_for_grade_c(ProgressStream,
|
|
Globals, Prefix, Grade, MainModuleName, AllModuleNames,
|
|
!Succeeded, !IO) :-
|
|
ExtInit = ext_cur_gs(ext_cur_gs_lib_init),
|
|
proposed_install_all_gs_files(ProgressStream, Globals, Prefix, Grade,
|
|
ExtInit, [MainModuleName], !Succeeded, !IO),
|
|
|
|
globals.lookup_bool_option(Globals, highlevel_code, HighLevelCode),
|
|
(
|
|
HighLevelCode = no
|
|
;
|
|
HighLevelCode = yes,
|
|
ExtMih = ext_cur_ngs_gs_max_cur(ext_cur_ngs_gs_max_cur_mih),
|
|
proposed_install_all_gs_files(ProgressStream, Globals, Prefix, Grade,
|
|
ExtMih, AllModuleNames, !Succeeded, !IO)
|
|
),
|
|
|
|
ExtA = ext_cur_gas_lib_lib_opt,
|
|
ExtSo = ext_cur_gas_lib_sh_lib_opt,
|
|
GenExtA = ext_cur_gas(ExtA),
|
|
GenExtSo = ext_cur_gas(ExtSo),
|
|
module_name_to_workspace_lib_file_name(Globals, "lib", GenExtA,
|
|
MainModuleName, StaticLibFileName),
|
|
module_name_to_workspace_lib_file_name(Globals, "lib", GenExtSo,
|
|
MainModuleName, SharedLibFileName),
|
|
ext_cur_gas_extension_dir(Globals, ExtA, _, StaticDirName),
|
|
ext_cur_gas_extension_dir(Globals, ExtSo, _, SharedDirName),
|
|
globals.lookup_string_option(Globals, target_arch, TargetArch),
|
|
StaticInstallDir = Prefix / StaticDirName / Grade / TargetArch,
|
|
SharedInstallDir = Prefix / SharedDirName / Grade / TargetArch,
|
|
|
|
make_dir_handle_any_error(ProgressStream, StaticInstallDir,
|
|
MakeStaticInstallDirSucceeded, !IO),
|
|
(
|
|
MakeStaticInstallDirSucceeded = did_not_succeed
|
|
;
|
|
MakeStaticInstallDirSucceeded = succeeded,
|
|
proposed_maybe_install_static_or_dynamic_archive(ProgressStream,
|
|
Globals, sos_static, StaticInstallDir, StaticLibFileName,
|
|
!Succeeded, !IO),
|
|
( if StaticLibFileName = SharedLibFileName then
|
|
true
|
|
else
|
|
( if StaticInstallDir = SharedInstallDir then
|
|
MakeSharedInstallDirSucceeded = succeeded
|
|
else
|
|
make_dir_handle_any_error(ProgressStream, SharedInstallDir,
|
|
MakeSharedInstallDirSucceeded, !IO)
|
|
),
|
|
(
|
|
MakeSharedInstallDirSucceeded = did_not_succeed
|
|
;
|
|
MakeSharedInstallDirSucceeded = succeeded,
|
|
proposed_maybe_install_static_or_dynamic_archive(
|
|
ProgressStream, Globals, sos_shared,
|
|
SharedInstallDir, SharedLibFileName, !Succeeded, !IO)
|
|
)
|
|
)
|
|
).
|
|
|
|
:- pred proposed_install_library_grade_specific_files_for_grade_java(
|
|
io.text_output_stream::in, globals::in, string::in, string::in,
|
|
module_name::in, list(module_name)::in,
|
|
maybe_succeeded::in, maybe_succeeded::out, io::di, io::uo) is det.
|
|
|
|
proposed_install_library_grade_specific_files_for_grade_java(ProgressStream,
|
|
Globals, Prefix, Grade, MainModuleName, _AllModuleNames,
|
|
!Succeeded, !IO) :-
|
|
ExtJar = ext_cur_gs_lib_jar,
|
|
GenExtJar = ext_cur_gs(ExtJar),
|
|
module_name_to_workspace_file_name(Globals, GenExtJar,
|
|
MainModuleName, JarFileName),
|
|
ext_cur_gs_extension_dir(ExtJar, _,
|
|
_LegacyJarDirName, ProposedJarDirName),
|
|
JarInstallDir = Prefix / ProposedJarDirName / Grade,
|
|
make_dir_handle_any_error(ProgressStream, JarInstallDir,
|
|
MakeJarInstallDirSucceeded, !IO),
|
|
(
|
|
MakeJarInstallDirSucceeded = did_not_succeed
|
|
;
|
|
MakeJarInstallDirSucceeded = succeeded,
|
|
install_file_to(ProgressStream, Globals, JarInstallDir, JarFileName,
|
|
!Succeeded, !IO)
|
|
).
|
|
|
|
:- pred proposed_install_library_grade_specific_files_for_grade_csharp(
|
|
io.text_output_stream::in, globals::in, string::in, string::in,
|
|
module_name::in, list(module_name)::in,
|
|
maybe_succeeded::in, maybe_succeeded::out, io::di, io::uo) is det.
|
|
|
|
proposed_install_library_grade_specific_files_for_grade_csharp(ProgressStream,
|
|
Globals, Prefix, Grade, MainModuleName, _AllModuleNames,
|
|
!Succeeded, !IO) :-
|
|
ExtCilDll = ext_cur_gs_lib_cil_dll,
|
|
GenExtCilDll = ext_cur_gs(ExtCilDll),
|
|
module_name_to_workspace_file_name(Globals, GenExtCilDll,
|
|
MainModuleName, CilDllFileName),
|
|
ext_cur_gs_extension_dir(ExtCilDll, _,
|
|
_LegacyCilDllDirName, ProposedCilDllDirName),
|
|
CilDllInstallDir = Prefix / ProposedCilDllDirName / Grade,
|
|
make_dir_handle_any_error(ProgressStream, CilDllInstallDir,
|
|
MakeCilDllInstallDirSucceeded, !IO),
|
|
(
|
|
MakeCilDllInstallDirSucceeded = did_not_succeed
|
|
;
|
|
MakeCilDllInstallDirSucceeded = succeeded,
|
|
install_file_to(ProgressStream, Globals, CilDllInstallDir,
|
|
CilDllFileName, !Succeeded, !IO)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- type ext_cur_gs_ns =< ext
|
|
---> ext_cur_ngs(ext_cur_ngs)
|
|
; ext_cur_gs(ext_cur_gs)
|
|
; ext_cur_ngs_gs(ext_cur_ngs_gs)
|
|
; ext_cur_ngs_gs_max_cur(ext_cur_ngs_gs_max_cur)
|
|
; ext_cur_ngs_gs_max_ngs(ext_cur_ngs_gs_max_ngs).
|
|
|
|
:- pred proposed_install_all_gs_files(io.text_output_stream::in, globals::in,
|
|
string::in, string::in, ext_cur_gs_ns::in, list(module_name)::in,
|
|
maybe_succeeded::in, maybe_succeeded::out, io::di, io::uo) is det.
|
|
|
|
proposed_install_all_gs_files(ProgressStream, Globals, Prefix, Grade,
|
|
Ext, ModuleNames, !Succeeded, !IO) :-
|
|
(
|
|
Ext = ext_cur_ngs(ExtNgs),
|
|
ext_cur_ngs_extension_dir(ExtNgs, _, ExtDirName)
|
|
;
|
|
Ext = ext_cur_gs(ExtGs),
|
|
ext_cur_gs_extension_dir(ExtGs, _, _, ExtDirName)
|
|
;
|
|
Ext = ext_cur_ngs_gs(ExtNgsGs),
|
|
ext_cur_ngs_gs_extension_dir(ExtNgsGs, _, ExtDirName)
|
|
;
|
|
Ext = ext_cur_ngs_gs_max_cur(ExtNgsGsMaxCur),
|
|
ext_cur_ngs_gs_max_cur_extension_dir(ExtNgsGsMaxCur, _, ExtDirName)
|
|
;
|
|
Ext = ext_cur_ngs_gs_max_ngs(ExtNgsGsMaxNgs),
|
|
ext_cur_ngs_gs_max_ngs_extension_dir(ExtNgsGsMaxNgs, _, ExtDirName)
|
|
),
|
|
|
|
InstallDir = Prefix / ExtDirName / Grade,
|
|
% XXX We can rely on the Prefix directory having been built
|
|
% the install of the non-grade-specific files of the current grade.
|
|
% Would this be more efficient if done by two calls make_single_directory,
|
|
% adding ExtDirName and Grade respectively?
|
|
make_dir_handle_any_error(ProgressStream, InstallDir,
|
|
MakeInstallDirSucceeded, !IO),
|
|
(
|
|
MakeInstallDirSucceeded = did_not_succeed
|
|
;
|
|
MakeInstallDirSucceeded = succeeded,
|
|
GenExt = coerce(Ext),
|
|
list.map(module_name_to_workspace_file_name(Globals, GenExt),
|
|
ModuleNames, FileNames),
|
|
install_files_to(ProgressStream, Globals, InstallDir,
|
|
FileNames, !Succeeded, !IO)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
% Utility predicates.
|
|
%---------------------------------------------------------------------------%
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Utility predicates for use with the LEGACY install directory structure.
|
|
%
|
|
|
|
% Install a file in the given directory, and in directory/Mercury/exts
|
|
% if the symlinks for the subdirectories couldn't be created
|
|
% (e.g. on Windows).
|
|
%
|
|
% XXX Rename and redocument.
|
|
%
|
|
% TODO: have our callers compute ExtDir from Ext
|
|
%
|
|
% TODO: delete the InstallDir argument after a week or two of usage
|
|
% *without* an assertion failure.
|
|
%
|
|
:- pred legacy_install_subdir_file(io.text_output_stream::in, globals::in,
|
|
libdir_map::in, dir_name::in, module_name::in, {ext, string}::in,
|
|
maybe_succeeded::in, maybe_succeeded::out, io::di, io::uo) is det.
|
|
|
|
legacy_install_subdir_file(ProgressStream, Globals, LibDirMap, InstallDir,
|
|
ModuleName, {Ext, ExtDir}, !Succeeded, !IO) :-
|
|
% NOTE The calls to install_file will use any directory name components
|
|
% of FileName to *find* the file to install, but the name of the
|
|
% installed file will include *only* the base name of FileName.
|
|
% XXX LEGACY
|
|
module_name_to_file_name(Globals, $pred, Ext, ModuleName,
|
|
FileName, _FileNameProposed),
|
|
map.lookup(LibDirMap, ExtDir, InstallTo),
|
|
(
|
|
InstallTo = install_to_cur_only(CurDir),
|
|
expect(unify(InstallDir, CurDir), $pred, "InstallDir != CurDir"),
|
|
install_file(ProgressStream, Globals, FileName, CurDir,
|
|
!Succeeded, !IO)
|
|
;
|
|
InstallTo = install_to_cur_ngs(CurDir, NgsDir),
|
|
expect(unify(InstallDir, CurDir), $pred, "InstallDir != CurDir"),
|
|
install_file(ProgressStream, Globals, FileName, CurDir,
|
|
!Succeeded, !IO),
|
|
expect(unify(InstallDir / "Mercury" / ExtDir, NgsDir), $pred,
|
|
"InstallDir != NgsDir"),
|
|
install_file(ProgressStream, Globals, FileName, NgsDir,
|
|
!Succeeded, !IO)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pred legacy_maybe_install_static_or_dynamic_archive(
|
|
io.text_output_stream::in, globals::in, static_or_shared::in,
|
|
file_name::in, dir_name::in, maybe_succeeded::in, maybe_succeeded::out,
|
|
io::di, io::uo) is det.
|
|
|
|
legacy_maybe_install_static_or_dynamic_archive(ProgressStream, Globals,
|
|
Linkage, FileName, InstallDir, !Succeeded, !IO) :-
|
|
globals.get_library_install_linkages(Globals, LibLinkages),
|
|
( if set.member(Linkage, LibLinkages) then
|
|
install_file(ProgressStream, Globals, FileName, InstallDir,
|
|
succeeded, InstallSucceeded0, !IO),
|
|
|
|
% We need to update the archive index after we copy it to the
|
|
% installation directory, because the linkers on some OSs complain
|
|
% if we don't.
|
|
( if
|
|
Linkage = sos_static,
|
|
InstallSucceeded0 = succeeded
|
|
then
|
|
BaseFileName = dir.det_basename(FileName),
|
|
InstalledFileName = InstallDir / BaseFileName,
|
|
generate_archive_index(ProgressStream, Globals, InstalledFileName,
|
|
RanlibSucceeded, !IO),
|
|
!:Succeeded = !.Succeeded `and` RanlibSucceeded
|
|
else
|
|
!:Succeeded = !.Succeeded `and` InstallSucceeded0
|
|
)
|
|
else
|
|
true
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% Map from the directory name associated with a given extension
|
|
% (such as "int0s" for .int0 files, or "analyses" for .analysis files)
|
|
% to the pathnames of the one or two directories we have created to store
|
|
% files with that extension.
|
|
%
|
|
% We use libdir_maps for extensions whose files are installed using
|
|
% install_subdir_file. Extensions whose files are installed directly
|
|
% with install_file will not appear in maps of this type.
|
|
%
|
|
:- type libdir_map == map(string, libdir_info).
|
|
|
|
:- type libdir_info
|
|
---> install_to_cur_ngs(dir_name, dir_name)
|
|
% Install files to both the cur directory (the first argument) and
|
|
% the non-grade-specific or ngs directory (the second argument).
|
|
%
|
|
% For non-grade-specific extensions, the first directory is
|
|
% the one where the installed file is intended to be found by
|
|
% --no-use-subdirs compiler invocations, while the second is for
|
|
% --use-subdirs compiler invocations.
|
|
%
|
|
% For grade-specific extensions, we use the same setup.
|
|
% I (zs) am not sure why, but my guess is documented in the
|
|
% big comment in make_grade_install_dirs.
|
|
; install_to_cur_only(dir_name).
|
|
% Install files only to the specified directory.
|
|
% This will be the cur directory, and the ngs directory
|
|
% will be a symlink to the cur directory.
|
|
|
|
%---------------------%
|
|
|
|
:- pred legacy_make_nonext_dir(io.text_output_stream::in, dir_name::in,
|
|
maybe_succeeded::in, maybe_succeeded::out, io::di, io::uo) is det.
|
|
|
|
legacy_make_nonext_dir(ProgressStream, DirName, !Succeeded, !IO) :-
|
|
make_directory(DirName, IOResult, !IO),
|
|
print_any_mkdir_error(ProgressStream, DirName, IOResult, !Succeeded, !IO).
|
|
|
|
:- pred legacy_make_ngs_dir(io.text_output_stream::in,
|
|
dir_name::in, file_name::in, maybe_succeeded::in, maybe_succeeded::out,
|
|
libdir_map::in, libdir_map::out, io::di, io::uo) is det.
|
|
|
|
legacy_make_ngs_dir(ProgressStream, CurDir, ExtDirName,
|
|
!Succeeded, !LibDirMap, !IO) :-
|
|
NgsDir = CurDir / "Mercury" / ExtDirName,
|
|
make_directory(NgsDir, IOResult, !IO),
|
|
print_any_mkdir_error(ProgressStream, NgsDir, IOResult, !Succeeded, !IO),
|
|
map.det_insert(ExtDirName, install_to_cur_ngs(CurDir, NgsDir), !LibDirMap).
|
|
|
|
% XXX BAD_SYMLINK This upward-pointing symlink makes it impossible
|
|
% to back up a Mercury install directory using scp. This is because
|
|
% scp treats symlinks not as symlinks, but as the file or directory
|
|
% they point to, and copies that (in this case) directory.
|
|
% That directory will of course contain this same symlink, and scp gets
|
|
% trapped, always copying the files in between in an infinite loop,
|
|
% which ends only when it has completely filled up the target filesystem.
|
|
%
|
|
% Another minor problem is that "diff -R" will refuse to traverse
|
|
% symlinks to ".." when comparing e.g. two install directories.
|
|
%
|
|
:- pred legacy_make_ngs_dir_symlink_to_cur(io.text_output_stream::in,
|
|
dir_name::in, file_name::in, maybe_succeeded::in, maybe_succeeded::out,
|
|
libdir_map::in, libdir_map::out, io::di, io::uo) is det.
|
|
|
|
legacy_make_ngs_dir_symlink_to_cur(ProgressStream, CurDir, ExtDirName,
|
|
!Succeeded, !LibDirMap, !IO) :-
|
|
NgsDir = CurDir / "Mercury" / ExtDirName,
|
|
definitely_make_symlink("..", NgsDir, LinkSucceeded, !IO),
|
|
(
|
|
LinkSucceeded = succeeded,
|
|
% If CurDir / "Mercury" / ExtDirName is a symlink to "..", then
|
|
% it points to CurDir.
|
|
LibDirInfo = install_to_cur_only(CurDir),
|
|
map.det_insert(ExtDirName, LibDirInfo, !LibDirMap)
|
|
;
|
|
LinkSucceeded = did_not_succeed,
|
|
% We don't print an error message if making the *symlink* fails;
|
|
% we only print one if making a *directory* fails.
|
|
legacy_make_ngs_dir(ProgressStream, CurDir, ExtDirName,
|
|
!Succeeded, !LibDirMap, !IO)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Utility predicates for use with the PROPOSED install directory structure.
|
|
%
|
|
|
|
:- pred gather_module_dep_infos(io.text_output_stream::in, globals::in,
|
|
list(module_name)::in, list(module_name)::out, maybe_succeeded::out,
|
|
make_info::in, make_info::out, io::di, io::uo) is det.
|
|
|
|
gather_module_dep_infos(ProgressStream, Globals, AllModuleNames,
|
|
ModulesWithChildren, Succeeded, !Info, !IO) :-
|
|
gather_module_dep_infos_loop(ProgressStream, Globals, AllModuleNames,
|
|
cord.init, ModulesWithChildrenCord,
|
|
cord.init, ModulesWithoutDepInfoCord, !Info, !IO),
|
|
ModulesWithChildren = cord.list(ModulesWithChildrenCord),
|
|
ModulesWithoutDepInfo = cord.list(ModulesWithoutDepInfoCord),
|
|
(
|
|
ModulesWithoutDepInfo = [],
|
|
Succeeded = succeeded
|
|
;
|
|
ModulesWithoutDepInfo = [_ | _],
|
|
% XXX The LEGACY install process does not print an error message
|
|
% for this error. The PROPOSED process should, but what should
|
|
% the message say?
|
|
Succeeded = did_not_succeed
|
|
).
|
|
|
|
:- pred gather_module_dep_infos_loop(io.text_output_stream::in, globals::in,
|
|
list(module_name)::in,
|
|
cord(module_name)::in, cord(module_name)::out,
|
|
cord(module_name)::in, cord(module_name)::out,
|
|
make_info::in, make_info::out, io::di, io::uo) is det.
|
|
|
|
gather_module_dep_infos_loop(_ProgressStream, _Globals, [],
|
|
!ModulesWithChildren, !ModulesWithoutDepInfo, !Info, !IO).
|
|
gather_module_dep_infos_loop(ProgressStream, Globals,
|
|
[ModuleName | ModuleNames],
|
|
!ModulesWithChildren, !ModulesWithoutDepInfo, !Info, !IO) :-
|
|
get_maybe_module_dep_info(ProgressStream, Globals,
|
|
ModuleName, MaybeModuleDepInfo, !Info, !IO),
|
|
(
|
|
MaybeModuleDepInfo = no_module_dep_info,
|
|
cord.snoc(ModuleName, !ModulesWithoutDepInfo)
|
|
;
|
|
MaybeModuleDepInfo = some_module_dep_info(ModuleDepInfo),
|
|
module_dep_info_get_children(ModuleDepInfo, Children),
|
|
( if set.is_non_empty(Children) then
|
|
cord.snoc(ModuleName, !ModulesWithChildren)
|
|
else
|
|
true
|
|
)
|
|
),
|
|
gather_module_dep_infos_loop(ProgressStream, Globals, ModuleNames,
|
|
!ModulesWithChildren, !ModulesWithoutDepInfo, !Info, !IO).
|
|
|
|
%---------------------%
|
|
|
|
:- pred proposed_maybe_install_static_or_dynamic_archive(
|
|
io.text_output_stream::in, globals::in, static_or_shared::in,
|
|
dir_name::in, file_name::in, maybe_succeeded::in, maybe_succeeded::out,
|
|
io::di, io::uo) is det.
|
|
|
|
proposed_maybe_install_static_or_dynamic_archive(ProgressStream, Globals,
|
|
Linkage, InstallDir, FileName, !Succeeded, !IO) :-
|
|
globals.get_library_install_linkages(Globals, LibLinkages),
|
|
( if set.member(Linkage, LibLinkages) then
|
|
install_file_to(ProgressStream, Globals, InstallDir, FileName,
|
|
succeeded, InstallSucceeded0, !IO),
|
|
% We need to update the archive index after we copy it to the
|
|
% installation directory, because the linkers on some OSs complain
|
|
% if we don't.
|
|
( if
|
|
Linkage = sos_static,
|
|
InstallSucceeded0 = succeeded
|
|
then
|
|
BaseFileName = dir.det_basename(FileName),
|
|
InstalledFileName = InstallDir / BaseFileName,
|
|
generate_archive_index(ProgressStream, Globals, InstalledFileName,
|
|
RanlibSucceeded, !IO),
|
|
!:Succeeded = !.Succeeded `and` RanlibSucceeded
|
|
else
|
|
!:Succeeded = !.Succeeded `and` InstallSucceeded0
|
|
)
|
|
else
|
|
true
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pred install_files_to(io.text_output_stream::in, globals::in,
|
|
dir_name::in, list(file_name)::in,
|
|
maybe_succeeded::in, maybe_succeeded::out, io::di, io::uo) is det.
|
|
|
|
install_files_to(ProgressStream, Globals, InstallDir, FileNames,
|
|
!Succeeded, !IO) :-
|
|
% XXX This code copies files to InstallDir one at a time.
|
|
% With install_method_external_cmd, this will incur all the overhead
|
|
% of invoke_system_command N times, where N is the number of module
|
|
% names in ModuleNames. That overhead will include
|
|
%
|
|
% - the creation of a shell process,
|
|
% - the creation of the process that does the copying (e.g. cp)
|
|
% - the creation, reading and removal of a temp file
|
|
% for storing the output of the process that does the copying.
|
|
%
|
|
% It would be more efficient if we invoked a *single* shell command
|
|
% to copy *all* FileNames to InstallDir.
|
|
%
|
|
% There are two potential flaws in this plan.
|
|
%
|
|
% - If FileNames is long enough, the length of the copy command
|
|
% string may exceed OS limits. We can work around such limits by
|
|
% using xargs-style chunking.
|
|
%
|
|
% - When would we print the "Installing <filename>" progress message?
|
|
% The answer does not matter in the absence of errors, but in their
|
|
% presence, the only non-misleading option is to print a single
|
|
% "Installing <filename1> <filename2> ..." message just as
|
|
% we are about to install a chunk of filenames. That would be
|
|
% a challenge to format in a readable but still non-misleading way.
|
|
list.foldl2(install_file_to(ProgressStream, Globals, InstallDir),
|
|
FileNames, !Succeeded, !IO).
|
|
|
|
%---------------------%
|
|
|
|
% Look up the filename under which the given module's file with the given
|
|
% extension is stored in the current workspace.
|
|
%
|
|
:- pred module_name_to_workspace_file_name(globals::in,
|
|
ext::in, module_name::in, file_name::out) is det.
|
|
|
|
module_name_to_workspace_file_name(Globals, Ext, ModuleName, FileName) :-
|
|
% XXX LEGACY For a transition period, we are copying from
|
|
% workspaces that have the LEGACY directory structure.
|
|
%
|
|
% Switching over will require
|
|
%
|
|
% - either a "flag day", where you do a realclean of your workspace,
|
|
% switch to a compiler install that uses the PROPOSED structure
|
|
% for workspaces as well as for installs, and rebuilding, or
|
|
% - switching from a workspace that uses --no-use-subdirs, in which
|
|
% the LEGACY and PROPOSED schemes both store all files in the same
|
|
% directory (the current directory).
|
|
module_name_to_file_name(Globals, $pred, Ext, ModuleName,
|
|
FileName, _FileNameProposed).
|
|
|
|
% This is the library version of module_name_to_workspace_file_name.
|
|
%
|
|
:- pred module_name_to_workspace_lib_file_name(globals::in, string::in,
|
|
ext::in, module_name::in, file_name::out) is det.
|
|
|
|
module_name_to_workspace_lib_file_name(Globals, LibPrefix, Ext,
|
|
MainModuleName, LibFileName) :-
|
|
% XXX LEGACY The comment in module_name_to_workspace_file_name
|
|
% applies here as well.
|
|
module_name_to_lib_file_name(Globals, $pred, LibPrefix, Ext,
|
|
MainModuleName, LibFileName, _LibFileNameProposed).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Utility predicates that should work with both the LEGACY and the PROPOSED
|
|
% install directory structure.
|
|
%
|
|
|
|
% Generate (or update) the index for an archive file,
|
|
% i.e. run ranlib on a .a file.
|
|
%
|
|
:- pred generate_archive_index(io.text_output_stream::in, globals::in,
|
|
file_name::in, maybe_succeeded::out, io::di, io::uo) is det.
|
|
|
|
generate_archive_index(ProgressStream, Globals, FileName, Succeeded, !IO) :-
|
|
verbose_make_two_part_msg(Globals, "Generating archive index for",
|
|
FileName, InstallMsg),
|
|
maybe_write_msg(ProgressStream, InstallMsg, !IO),
|
|
globals.lookup_string_option(Globals, ranlib_command, RanLibCommand),
|
|
globals.lookup_string_option(Globals, ranlib_flags, RanLibFlags),
|
|
% XXX Why are we executing Command if RanLibCommand is the empty string?
|
|
% juliensf says: "Technically a bug, but with the current configuration
|
|
% script and set of OSs we support, it shouldn't ever happen except by
|
|
% someone manually editing a configuration file. (That's likely to break
|
|
% their Mercury installation ...)"
|
|
Command = string.join_list(" ", [
|
|
% Note that it is possible, though not likely, that the ranlib_command
|
|
% option might be set to a command name that requires quoting. juliensf
|
|
% says: "The C compiler toolchains and binutils let users specify
|
|
% suffixes that are included in the executable names -- this is
|
|
% usually use in cross compiler toolchains."
|
|
quote_shell_cmd_arg(RanLibCommand),
|
|
RanLibFlags,
|
|
quote_shell_cmd_arg(FileName)
|
|
]),
|
|
% XXX MAKE_STREAM
|
|
CmdOutputStream = ProgressStream,
|
|
invoke_system_command(Globals, ProgressStream,
|
|
CmdOutputStream, cmd_verbose, Command, Succeeded, !IO).
|
|
|
|
%---------------------%
|
|
|
|
:- pred install_file_to(io.text_output_stream::in, globals::in,
|
|
dir_name::in, file_name::in, maybe_succeeded::in, maybe_succeeded::out,
|
|
io::di, io::uo) is det.
|
|
|
|
install_file_to(ProgressStream, Globals, InstallDir, FileName,
|
|
!Succeeded, !IO) :-
|
|
install_file(ProgressStream, Globals, FileName, InstallDir,
|
|
!Succeeded, !IO).
|
|
|
|
:- pred install_file(io.text_output_stream::in, globals::in,
|
|
file_name::in, dir_name::in, maybe_succeeded::in, maybe_succeeded::out,
|
|
io::di, io::uo) is det.
|
|
|
|
install_file(ProgressStream, Globals, FileName, InstallDir, !Succeeded, !IO) :-
|
|
verbose_make_four_part_msg(Globals, "Installing file", FileName,
|
|
"in", InstallDir, InstallMsg),
|
|
maybe_write_msg(ProgressStream, InstallMsg, !IO),
|
|
copy_file_to_directory(Globals, ProgressStream, FileName,
|
|
InstallDir, CopySucceeded, !IO),
|
|
!:Succeeded = !.Succeeded `and` CopySucceeded.
|
|
|
|
%---------------------%
|
|
|
|
:- pred remove_target_file_if_grade_dependent(target_id::in, target_status::in,
|
|
version_hash_table(target_id, target_status)::in,
|
|
version_hash_table(target_id, target_status)::out) is det.
|
|
|
|
remove_target_file_if_grade_dependent(TargetId, _Status, !StatusMap) :-
|
|
( if
|
|
TargetId = merc_target(target_file(_, TargetType)),
|
|
is_target_grade_dependent(TargetType) = grade_dependent
|
|
then
|
|
version_hash_table.delete(TargetId, !StatusMap)
|
|
else
|
|
true
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pred make_dir_handle_any_error(io.text_output_stream::in, dir_name::in,
|
|
maybe_succeeded::out, io::di, io::uo) is det.
|
|
|
|
make_dir_handle_any_error(ProgressStream, DirName, Succeeded, !IO) :-
|
|
dir.make_directory(DirName, MakeDirResult, !IO),
|
|
print_any_mkdir_error(ProgressStream, DirName, MakeDirResult,
|
|
succeeded, Succeeded, !IO).
|
|
|
|
:- pred print_any_mkdir_error(io.text_output_stream::in, dir_name::in,
|
|
io.res::in, maybe_succeeded::in, maybe_succeeded::out,
|
|
io::di, io::uo) is det.
|
|
|
|
print_any_mkdir_error(ProgressStream, DirName, Result, !Succeeded, !IO) :-
|
|
(
|
|
Result = ok
|
|
;
|
|
Result = error(Error),
|
|
print_mkdir_error(ProgressStream, DirName, Error, !:Succeeded, !IO)
|
|
).
|
|
|
|
:- pred print_mkdir_error(io.text_output_stream::in, dir_name::in,
|
|
io.error::in, maybe_succeeded::out, io::di, io::uo) is det.
|
|
|
|
print_mkdir_error(ProgressStream, DirName, Error, !:Succeeded, !IO) :-
|
|
ErrorMsg = io.error_message(Error),
|
|
io.format(ProgressStream,
|
|
"Error creating installation directory %s: %s\n",
|
|
[s(DirName), s(ErrorMsg)], !IO),
|
|
!:Succeeded = did_not_succeed.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module make.library_install.
|
|
%---------------------------------------------------------------------------%
|