mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2025-12-16 14:25:56 +00:00
Code Issues Projects Releases Wiki Activity
Files
d69ba1a1f0596e7f740b1a788350b5dcb343c276
mercury/compiler/make.util.m
Peter Wang 6f699e9d3e Make `mmc --make' work for Java grade. 
Branches: main

Make `mmc --make' work for Java grade.

compiler/make.dependencies.m:
compiler/make.m:
compiler/make.module_target.m:
compiler/make.program_target.m:
compiler/make.util.m:
        Make `mmc --make' know to generate `.class' files.

compiler/compile_target_code.m:
        Pass "-sourcepath Mercury/javas" to javac when using subdirectories.

compiler/module_cmds.m:
        Make the shell script we generate to invoke `java' pass command line
        arguments through to the user program.  `exec' the java process.

library/Mmakefile:
        Use $(ALL_JAVACFLAGS) when compiling standard library modules so
        $(EXTRA_JAVACFLAGS) has its effect.
2009-04-30 04:37:27 +00:00

1748 lines
63 KiB
Mathematica
Raw Blame History

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2002-2008 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: make.util.m.
% Main author: stayl.
%
% Assorted predicates used to implement `mmc --make'.
%
%-----------------------------------------------------------------------------%
:- module make.util.
:- interface.
%-----------------------------------------------------------------------------%
%
% Versions of foldl which stop if the supplied predicate returns `no'
% for any element of the list.
%
% foldl2_pred_with_status(T, Succeeded, !Info).
%
:- type foldl2_pred_with_status(T, Info, IO) ==
pred(T, bool, Info, Info, IO, IO).
:- inst foldl2_pred_with_status == (pred(in, out, in, out, di, uo) is det).
% foldl2_maybe_stop_at_error(KeepGoing, P, List, Succeeded, !Info).
%
:- pred foldl2_maybe_stop_at_error(bool::in,
foldl2_pred_with_status(T, Info, IO)::in(foldl2_pred_with_status),
list(T)::in, bool::out, Info::in, Info::out, IO::di, IO::uo) is det.
% foldl3_pred_with_status(T, Succeeded, !Acc, !Info).
%
:- type foldl3_pred_with_status(T, Acc, Info, IO) ==
pred(T, bool, Acc, Acc, Info, Info, IO, IO).
:- inst foldl3_pred_with_status ==
(pred(in, out, in, out, in, out, di, uo) is det).
% foldl3_maybe_stop_at_error(KeepGoing, P, List, Succeeded, !Acc,
% !Info).
%
:- pred foldl3_maybe_stop_at_error(bool::in,
foldl3_pred_with_status(T, Acc, Info, IO)::in(foldl3_pred_with_status),
list(T)::in, bool::out, Acc::in, Acc::out, Info::in, Info::out,
IO::di, IO::uo) is det.
%-----------------------------------------------------------------------------%
% foldl2_maybe_stop_at_error_maybe_parallel(KeepGoing, P, List, Succeeded,
% !Info, !IO).
%
% Like foldl2_maybe_stop_at_error, but if parallel make is enabled, it
% tries to perform a first pass that overlaps execution of P(elem) in
% separate threads or processes. Updates to !Info in the first pass are
% ignored. If the first pass succeeds, a second sequential pass is made in
% which updates !Info are kept. Hence it must be safe to execute P(elem)
% concurrently, in any order, and multiple times.
%
:- pred foldl2_maybe_stop_at_error_maybe_parallel(bool::in,
foldl2_pred_with_status(T, make_info, io)::in(foldl2_pred_with_status),
list(T)::in, bool::out, make_info::in, make_info::out, io::di, io::uo)
is det.
%-----------------------------------------------------------------------------%
:- type build(T, Info1, Info2) == pred(T, bool, Info1, Info2, io, io).
:- type build(T, Info) == build(T, Info, Info).
:- type build(T) == build(T, make_info).
:- inst build == (pred(in, out, in, out, di, uo) is det).
% build_with_module_options(ModuleName, ExtraArgs, Builder, Succeeded,
% !Info).
%
% Perform the given closure after updating the option_table in the globals
% in the io.state to contain the module-specific options for the specified
% module and the extra options given in the ExtraArgs.
% Adds `--invoked-by-mmc-make' and `--use-subdirs' to the option list.
% The old option table will be restored afterwards.
%
:- pred build_with_module_options(module_name::in,
list(string)::in, build(list(string))::in(build), bool::out,
make_info::in, make_info::out, io::di, io::uo) is det.
% build_with_module_options_args(ModuleName, OptionsVariables,
% OptionArgs, ExtraArgs, Builder, Succeeded, !Info).
%
% Perform the given closure after updating the option_table in the globals
% in the io.state to contain the module-specific options for the specified
% module and the extra options given in ExtraArgs and OptionArgs.
% Does not add `--invoked-by-mmc-make' and `--use-subdirs' to the
% option list. The old option table will be restored afterwards.
%
:- pred build_with_module_options_args(module_name::in, options_variables::in,
list(string)::in, list(string)::in,
build(list(string), Info1, Info2)::in(build),
bool::out, Info1::in, maybe(Info2)::out, io::di, io::uo) is det.
% Perform the given closure with an output stream created
% to append to the error file for the given module.
%
:- pred build_with_output_redirect(module_name::in,
build(io.output_stream)::in(build), bool::out,
make_info::in, make_info::out, io::di, io::uo) is det.
% Produce an output stream which writes to the error file
% for the given module.
%
:- pred redirect_output(module_name::in, maybe(io.output_stream)::out,
make_info::in, make_info::out, io::di, io::uo) is det.
% Close the module error output stream.
%
:- pred unredirect_output(module_name::in, io.output_stream::in,
make_info::in, make_info::out, io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
:- type build2(T, U) == pred(T, U, bool, make_info, make_info, io, io).
:- inst build2 == (pred(in, in, out, in, out, di, uo) is det).
:- pred build_with_module_options_and_output_redirect(module_name::in,
list(string)::in, build2(list(string), io.output_stream)::in(build2),
bool::out, make_info::in, make_info::out, io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
%
% Timestamp handling
%
% Find the timestamp updated when a target is produced.
%
:- pred get_timestamp_file_timestamp(target_file::in,
maybe_error(timestamp)::out, make_info::in, make_info::out,
io::di, io::uo) is det.
% Find the timestamp for the given dependency file.
%
:- pred get_dependency_timestamp(dependency_file::in,
maybe_error(timestamp)::out, make_info::in, make_info::out,
io::di, io::uo) is det.
% get_target_timestamp(Search, TargetFile, Timestamp)
%
% Find the timestamp for the given target file.
% `Search' should be `do_search' if the file could be part of an
% installed library.
%
:- pred get_target_timestamp(maybe_search::in, target_file::in,
maybe_error(timestamp)::out, make_info::in, make_info::out,
io::di, io::uo) is det.
% get_file_name(Search, TargetFile, FileName).
%
% Compute a file name for the given target file.
% `Search' should be `do_search' if the file could be part of an
% installed library.
%
:- pred get_file_name(maybe_search::in, target_file::in, file_name::out,
make_info::in, make_info::out, io::di, io::uo) is det.
% Find the timestamp of the first file matching the given
% file name in one of the given directories.
%
:- pred get_file_timestamp(list(dir_name)::in, file_name::in,
maybe_error(timestamp)::out, make_info::in, make_info::out,
io::di, io::uo) is det.
% Return the oldest of the timestamps if both are of the form
% `ok(Timestamp)', returning `error(Error)' otherwise.
%
:- func find_oldest_timestamp(maybe_error(timestamp),
maybe_error(timestamp)) = maybe_error(timestamp).
%-----------------------------------------------------------------------------%
%
% Remove file a file, deleting the cached timestamp
% The removal is reported to the user if the given boolean option is set.
% In general the option given should be `--very-verbose' when making a
% `.clean' or `.realclean target', and `--verbose-make' when cleaning
% after an interrupted build.
%
% Remove the target file and the corresponding timestamp file.
%
:- pred make_remove_target_file(option::in, target_file::in,
make_info::in, make_info::out, io::di, io::uo) is det.
% Remove the target file and the corresponding timestamp file.
%
:- pred make_remove_target_file(option::in, module_name::in,
module_target_type::in, make_info::in, make_info::out,
io::di, io::uo) is det.
% make_remove_file(VerboseOption, ModuleName, Extension, !Info).
%
:- pred make_remove_file(option::in, module_name::in, string::in,
make_info::in, make_info::out, io::di, io::uo) is det.
:- pred make_remove_file(option::in, file_name::in,
make_info::in, make_info::out, io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
:- func make_target_file_list(list(module_name), module_target_type) =
list(target_file).
:- func make_dependency_list(list(module_name), module_target_type)
= list(dependency_file).
:- func target_extension(globals, module_target_type) = maybe(string).
:- mode target_extension(in, in) = out is det.
:- mode target_extension(in, out) = in(bound(yes(ground))) is nondet.
:- pred linked_target_file_name(module_name::in, linked_target_type::in,
file_name::out, io::di, io::uo) is det.
% Find the extension for the timestamp file for the
% given target type, if one exists.
%
:- func timestamp_extension(globals, module_target_type) = string is semidet.
:- pred target_is_grade_or_arch_dependent(module_target_type::in) is semidet.
%-----------------------------------------------------------------------------%
%
% Debugging, verbose and error messages
%
% Apply the given predicate if `--debug-make' is set.
% XXX Do we need this, now that we have trace goals?
%
:- pred debug_msg(pred(io, io)::(pred(di, uo) is det), io::di, io::uo) is det.
% Apply the given predicate if `--verbose-make' is set.
% XXX Do we need this, now that we have trace goals?
%
:- pred verbose_msg(pred(io, io)::(pred(di, uo) is det),
io::di, io::uo) is det.
% Apply the given predicate if the given boolean option is set to `yes'.
% XXX Do we need this, now that we have trace goals?
%
:- pred verbose_msg(option::in, pred(io, io)::(pred(di, uo) is det),
io::di, io::uo) is det.
% Write a debugging message relating to a given target file.
%
:- pred debug_file_msg(target_file::in, string::in, io::di, io::uo) is det.
:- pred make_write_dependency_file(dependency_file::in, io::di, io::uo) is det.
:- pred make_write_dependency_file_list(list(dependency_file)::in,
io::di, io::uo) is det.
:- pred make_write_target_file(target_file::in, io::di, io::uo) is det.
% Write a message "Making <filename>" if `--verbose-make' is set.
%
:- pred maybe_make_linked_target_message(file_name::in, io::di, io::uo) is det.
% Write a message "Making <filename>" if `--verbose-make' is set.
%
:- pred maybe_make_target_message(target_file::in, io::di, io::uo) is det.
:- pred maybe_make_target_message_to_stream(io.output_stream::in,
target_file::in, io::di, io::uo) is det.
% Write a message "Reanalysing invalid/suboptimal modules" if
% `--verbose-make' is set.
%
:- pred maybe_reanalyse_modules_message(io::di, io::uo) is det.
% Write a message "** Error making <filename>".
%
:- pred target_file_error(target_file::in, io::di, io::uo) is det.
% Write a message "** Error making <filename>".
%
:- pred file_error(file_name::in, io::di, io::uo) is det.
% If the given target was specified on the command line, warn that it
% was already up to date.
%
:- pred maybe_warn_up_to_date_target(pair(module_name, target_type)::in,
make_info::in, make_info::out, io::di, io::uo) is det.
% Write a message "Made symlink/copy of <filename>" if
% `--verbose-make' is set.
%
:- pred maybe_symlink_or_copy_linked_target_message(
pair(module_name, target_type)::in, io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
%
% Timing
%
:- pred get_real_milliseconds(int::out, io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
%
% Hash functions
%
:- pred module_name_hash(module_name::in, int::out) is det.
:- pred dependency_file_hash(dependency_file::in, int::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module analysis.
:- import_module libs.compiler_util.
:- import_module libs.handle_options.
:- import_module libs.process_util.
:- import_module parse_tree.file_names.
:- import_module parse_tree.prog_foreign.
:- import_module transform_hlds.
:- import_module transform_hlds.mmc_analysis.
:- import_module bool.
:- import_module char.
:- import_module dir.
:- import_module exception.
:- import_module getopt_io.
:- import_module set.
:- import_module thread.
:- import_module thread.channel.
:- import_module unit.
:- import_module univ.
%-----------------------------------------------------------------------------%
foldl2_maybe_stop_at_error(KeepGoing, MakeTarget, Targets, Success,
!Info, !IO) :-
foldl2_maybe_stop_at_error_2(KeepGoing, MakeTarget, Targets, yes, Success,
!Info, !IO).
:- pred foldl2_maybe_stop_at_error_2(bool::in,
foldl2_pred_with_status(T, Info, IO)::in(foldl2_pred_with_status),
list(T)::in, bool::in, bool::out, Info::in, Info::out,
IO::di, IO::uo) is det.
foldl2_maybe_stop_at_error_2(_KeepGoing, _P, [], !Success, !Info, !IO).
foldl2_maybe_stop_at_error_2(KeepGoing, P, [T | Ts], !Success, !Info, !IO) :-
P(T, NewSuccess, !Info, !IO),
(
( NewSuccess = yes
; KeepGoing = yes
)
->
!:Success = !.Success `and` NewSuccess,
foldl2_maybe_stop_at_error_2(KeepGoing, P, Ts, !Success, !Info, !IO)
;
!:Success = no
).
foldl3_maybe_stop_at_error(KeepGoing, P, Ts, Success, !Acc, !Info, !IO) :-
foldl3_maybe_stop_at_error_2(KeepGoing, P, Ts, yes, Success,
!Acc, !Info, !IO).
:- pred foldl3_maybe_stop_at_error_2(bool::in,
foldl3_pred_with_status(T, Acc, Info, IO)::in(foldl3_pred_with_status),
list(T)::in, bool::in, bool::out, Acc::in, Acc::out,
Info::in, Info::out, IO::di, IO::uo) is det.
foldl3_maybe_stop_at_error_2(_KeepGoing, _P, [], !Success, !Acc, !Info, !IO).
foldl3_maybe_stop_at_error_2(KeepGoing, P, [T | Ts],
!Success, !Acc, !Info, !IO) :-
P(T, NewSuccess, !Acc, !Info, !IO),
(
( NewSuccess = yes
; KeepGoing = yes
)
->
!:Success = !.Success `and` NewSuccess,
foldl3_maybe_stop_at_error_2(KeepGoing, P, Ts, !Success, !Acc,
!Info, !IO)
;
!:Success = no
).
%-----------------------------------------------------------------------------%
%
% Parallel (concurrent) fold
%
:- type child_exit
---> child_succeeded
; child_failed
; child_exception(univ).
:- inst child_succeeded_or_failed
---> child_succeeded
; child_failed.
% A generic interface for the two parallel fold implementations:
% one using processes and one using threads.
%
:- typeclass par_fold(PF) where [
% run_in_child(Pred, Info, T, Succeeded, !PF, !IO)
%
% Start executing Pred in a child thread/process. Succeeded is `yes' iff
% the child was successfully spawned.
%
pred run_in_child(
foldl2_pred_with_status(T, Info, io)::in(foldl2_pred_with_status),
Info::in, T::in, bool::out, PF::in, PF::out, io::di, io::uo) is det,
% Block until a child exit code is received.
%
pred wait_for_child_exit(child_exit::out(child_succeeded_or_failed),
PF::in, PF::out, io::di, io::uo) is det
].
foldl2_maybe_stop_at_error_maybe_parallel(KeepGoing, MakeTarget, Targets,
Success, !Info, !IO) :-
globals.io_lookup_int_option(jobs, Jobs, !IO),
( Jobs > 1 ->
% First pass.
% fork() is disabled on threaded grades.
( process_util.can_fork ->
foldl2_maybe_stop_at_error_parallel_processes(KeepGoing, Jobs,
MakeTarget, Targets, Success0, !.Info, !IO)
; thread.can_spawn ->
foldl2_maybe_stop_at_error_parallel_threads(KeepGoing, Jobs,
MakeTarget, Targets, Success0, !.Info, !IO)
;
Success0 = yes
),
% Second pass (sequential).
(
Success0 = yes,
% Disable the `--rebuild' option during the sequential pass
% otherwise all the targets will be built a second time.
globals.io_lookup_bool_option(rebuild, Rebuild, !IO),
globals.io_set_option(rebuild, bool(no), !IO),
foldl2_maybe_stop_at_error(KeepGoing, MakeTarget, Targets, Success,
!Info, !IO),
globals.io_set_option(rebuild, bool(Rebuild), !IO)
;
Success0 = no,
Success = no
)
;
foldl2_maybe_stop_at_error(KeepGoing, MakeTarget, Targets, Success,
!Info, !IO)
).
:- pred do_parallel_foldl2(bool::in, int::in,
foldl2_pred_with_status(T, Info, io)::in(foldl2_pred_with_status),
Info::in, list(T)::in, bool::out, PF::in, PF::out, io::di, io::uo)
is det <= par_fold(PF).
do_parallel_foldl2(KeepGoing, Jobs, MakeTarget, Info, Targets, Success,
!PF, !IO) :-
list.split_upto(Jobs, Targets, InitialTargets, LaterTargets),
start_initial_child_jobs(KeepGoing, MakeTarget, Info, InitialTargets,
0, NumChildJobs, !PF, !IO),
( NumChildJobs < length(InitialTargets) ->
Success0 = no
;
Success0 = yes
),
do_parallel_foldl2_parent_loop(KeepGoing, MakeTarget, Info,
NumChildJobs, LaterTargets, Success0, Success, !PF, !IO).
:- pred start_initial_child_jobs(bool::in,
foldl2_pred_with_status(T, Info, io)::in(foldl2_pred_with_status),
Info::in, list(T)::in, int::in, int::out,
PF::in, PF::out, io::di, io::uo) is det <= par_fold(PF).
start_initial_child_jobs(_KeepGoing, _MakeTarget, _Info,
[], !NumChildJobs, !PF, !IO).
start_initial_child_jobs(KeepGoing, MakeTarget, Info,
[Target | Targets], !NumChildJobs, !PF, !IO) :-
run_in_child(MakeTarget, Info, Target, Success, !PF, !IO),
(
Success = yes,
start_initial_child_jobs(KeepGoing, MakeTarget, Info, Targets,
!.NumChildJobs + 1, !:NumChildJobs, !PF, !IO)
;
Success = no,
KeepGoing = yes,
start_initial_child_jobs(KeepGoing, MakeTarget, Info, Targets,
!NumChildJobs, !PF, !IO)
;
Success = no,
KeepGoing = no
).
:- pred do_parallel_foldl2_parent_loop(bool::in,
foldl2_pred_with_status(T, Info, io)::in(foldl2_pred_with_status),
Info::in, int::in, list(T)::in, bool::in, bool::out, PF::in, PF::out,
io::di, io::uo) is det <= par_fold(PF).
do_parallel_foldl2_parent_loop(KeepGoing, MakeTarget, Info, NumChildJobs0,
Targets, !Success, !PF, !IO) :-
(
% We are done once all running children have terminated and there are
% no more targets to make.
NumChildJobs0 = 0,
Targets = []
->
true
;
% Wait for a running child to indicate that it is finished.
wait_for_child_exit(Exit, !PF, !IO),
(
Exit = child_succeeded,
NewSuccess = yes
;
Exit = child_failed,
NewSuccess = no
),
(
( NewSuccess = yes
; KeepGoing = yes
)
->
!:Success = !.Success `and` NewSuccess,
(
Targets = [],
MoreTargets = [],
NumChildJobs = NumChildJobs0 - 1
;
Targets = [NextTarget | MoreTargets],
run_in_child(MakeTarget, Info, NextTarget, ChildStarted,
!PF, !IO),
(
ChildStarted = yes,
NumChildJobs = NumChildJobs0
;
ChildStarted = no,
NumChildJobs = NumChildJobs0 - 1,
!:Success = no
)
),
do_parallel_foldl2_parent_loop(KeepGoing, MakeTarget, Info,
NumChildJobs, MoreTargets, !Success, !PF, !IO)
;
% Wait for the other running children to terminate before
% returning.
!:Success = no,
wait_for_child_exits(NumChildJobs0 - 1, !PF, !IO)
)
).
:- pred wait_for_child_exits(int::in,
PF::in, PF::out, io::di, io::uo) is det <= par_fold(PF).
wait_for_child_exits(Num, !PF, !IO) :-
( Num > 0 ->
wait_for_child_exit(_, !PF, !IO),
wait_for_child_exits(Num - 1, !PF, !IO)
;
true
).
%-----------------------------------------------------------------------------%
%
% Parallel fold using processes
%
:- type fork_par_fold
---> fork_par_fold(
fpf_children :: set(pid)
).
:- instance par_fold(fork_par_fold) where [
pred(run_in_child/8) is run_in_child_process,
pred(wait_for_child_exit/5) is wait_for_child_process_exit
].
:- pred foldl2_maybe_stop_at_error_parallel_processes(bool::in, int::in,
foldl2_pred_with_status(T, Info, io)::in(foldl2_pred_with_status),
list(T)::in, bool::out, Info::in, io::di, io::uo) is det.
foldl2_maybe_stop_at_error_parallel_processes(KeepGoing, Jobs, MakeTarget,
Targets, Success, Info, !IO) :-
PF0 = fork_par_fold(set.init),
do_parallel_foldl2(KeepGoing, Jobs, MakeTarget, Info, Targets,
Success, PF0, _PF, !IO).
:- pred run_in_child_process(
foldl2_pred_with_status(T, Info, io)::in(foldl2_pred_with_status),
Info::in, T::in, bool::out, fork_par_fold::in, fork_par_fold::out,
io::di, io::uo) is det.
run_in_child_process(P, Info, T, ChildStarted, PF0, PF, !IO) :-
start_in_forked_process(
(pred(Success::out, !.IO::di, !:IO::uo) is det :-
P(T, Success, Info, _Info, !IO)
), MaybePid, !IO),
(
MaybePid = yes(Pid),
ChildStarted = yes,
PF0 = fork_par_fold(Set0),
set.insert(Set0, Pid, Set),
PF = fork_par_fold(Set)
;
MaybePid = no,
ChildStarted = no,
PF = PF0
).
:- pred wait_for_child_process_exit(child_exit::out(child_succeeded_or_failed),
fork_par_fold::in, fork_par_fold::out, io::di, io::uo) is det.
wait_for_child_process_exit(ChildExit, PF0, PF, !IO) :-
wait_any(DeadPid, ChildStatus, !IO),
fork_par_fold(Pids0) = PF0,
( set.remove(Pids0, DeadPid, Pids) ->
( ChildStatus = ok(exited(0)) ->
ChildExit = child_succeeded
;
ChildExit = child_failed
),
PF = fork_par_fold(Pids)
;
% Not a child of ours, maybe a grand child. Ignore it.
wait_for_child_process_exit(ChildExit, PF0, PF, !IO)
).
%-----------------------------------------------------------------------------%
%
% Parallel fold using threads
%
:- type thread_par_fold
---> thread_par_fold(
tpf_channel :: channel(child_exit),
% A channel to communicate between the children
% and the parent.
tpf_maybe_excp :: maybe(univ)
% Remember the first of any exceptions thrown
% by child threads.
).
:- instance par_fold(thread_par_fold) where [
pred(run_in_child/8) is run_in_child_thread,
pred(wait_for_child_exit/5) is wait_for_child_thread_exit
].
:- pred foldl2_maybe_stop_at_error_parallel_threads(bool::in, int::in,
foldl2_pred_with_status(T, Info, io)::in(foldl2_pred_with_status),
list(T)::in, bool::out, Info::in, io::di, io::uo) is det.
foldl2_maybe_stop_at_error_parallel_threads(KeepGoing, Jobs, MakeTarget,
Targets, Success, Info, !IO) :-
channel.init(Channel, !IO),
PF0 = thread_par_fold(Channel, no),
do_parallel_foldl2(KeepGoing, Jobs, MakeTarget, Info, Targets, Success,
PF0, PF, !IO),
%
% Rethrow the first of any exceptions which terminated a child thread.
%
MaybeExcp = PF ^ tpf_maybe_excp,
(
MaybeExcp = yes(Excp),
rethrow(exception(Excp) : exception_result(unit))
;
MaybeExcp = no
).
:- pred run_in_child_thread(
foldl2_pred_with_status(T, Info, io)::in(foldl2_pred_with_status),
Info::in, T::in, bool::out, thread_par_fold::in, thread_par_fold::out,
io::di, io::uo) is det.
run_in_child_thread(P, Info, T, ChildStarted, PF, PF, !IO) :-
promise_equivalent_solutions [!:IO] (
spawn((pred(!.IO::di, !:IO::uo) is cc_multi :-
try_io((pred(Succ::out, !.IO::di, !:IO::uo) is det :-
P(T, Succ, Info, _Info, !IO)
), Result, !IO),
(
Result = succeeded(yes),
Exit = child_succeeded
;
Result = succeeded(no),
Exit = child_failed
;
Result = exception(Excp),
Exit = child_exception(Excp)
),
channel.put(PF ^ tpf_channel, Exit, !IO)
), !IO)
),
ChildStarted = yes.
:- pred wait_for_child_thread_exit(child_exit::out(child_succeeded_or_failed),
thread_par_fold::in, thread_par_fold::out, io::di, io::uo) is det.
wait_for_child_thread_exit(ChildExit, !PF, !IO) :-
channel.take(!.PF ^ tpf_channel, ChildExit0, !IO),
(
( ChildExit0 = child_succeeded
; ChildExit0 = child_failed
),
ChildExit = ChildExit0
;
ChildExit0 = child_exception(Excp),
ChildExit = child_failed,
MaybeExcp0 = !.PF ^ tpf_maybe_excp,
(
MaybeExcp0 = no,
!PF ^ tpf_maybe_excp := yes(Excp)
;
MaybeExcp0 = yes(_)
)
).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
build_with_module_options_and_output_redirect(ModuleName, ExtraOptions,
Build, Succeeded, !Info, !IO) :-
build_with_module_options(ModuleName, ExtraOptions,
build_with_module_options_and_output_redirect_2(ModuleName, Build),
Succeeded, !Info, !IO).
:- pred build_with_module_options_and_output_redirect_2(module_name::in,
build2(list(string), io.output_stream)::in(build2), list(string)::in,
bool::out, make_info::in, make_info::out, io::di, io::uo) is det.
build_with_module_options_and_output_redirect_2(ModuleName, Build, AllOptions,
Succeeded, !Info, !IO) :-
build_with_output_redirect(ModuleName,
build_with_module_options_and_output_redirect_3(AllOptions, Build),
Succeeded, !Info, !IO).
:- pred build_with_module_options_and_output_redirect_3(list(string)::in,
build2(list(string), io.output_stream)::in(build2),
io.output_stream::in, bool::out, make_info::in, make_info::out,
io::di, io::uo) is det.
build_with_module_options_and_output_redirect_3(AllOptions, Build,
ErrorStream, Succeeded, !Info, !IO) :-
Build(AllOptions, ErrorStream, Succeeded, !Info, !IO).
build_with_output_redirect(ModuleName, Build, Succeeded, !Info, !IO) :-
redirect_output(ModuleName, RedirectResult, !Info, !IO),
(
RedirectResult = no,
Succeeded = no
;
RedirectResult = yes(ErrorStream),
Build(ErrorStream, Succeeded, !Info, !IO),
unredirect_output(ModuleName, ErrorStream, !Info, !IO)
).
build_with_module_options(ModuleName, ExtraOptions, Build, Succeeded,
!Info, !IO) :-
build_with_module_options_args_invoked(yes, ModuleName,
!.Info ^ options_variables, !.Info ^ option_args, ExtraOptions, Build,
Succeeded, !.Info, MaybeInfo, !IO),
(
MaybeInfo = yes(!:Info)
;
MaybeInfo = no
).
build_with_module_options_args(ModuleName, OptionVariables,
OptionArgs, ExtraOptions, Build, Succeeded, !Info, !IO) :-
build_with_module_options_args_invoked(no, ModuleName, OptionVariables,
OptionArgs, ExtraOptions, Build, Succeeded, !Info, !IO).
:- pred build_with_module_options_args_invoked(bool::in, module_name::in,
options_variables::in, list(string)::in, list(string)::in,
build(list(string), Info1, Info2)::in(build),
bool::out, Info1::in, maybe(Info2)::out, io::di, io::uo) is det.
build_with_module_options_args_invoked(InvokedByMmcMake, ModuleName,
OptionVariables, OptionArgs, ExtraOptions, Build, Succeeded,
Info0, MaybeInfo, !IO) :-
lookup_mmc_module_options(OptionVariables, ModuleName, OptionsResult, !IO),
(
OptionsResult = no,
MaybeInfo = no,
Succeeded = no
;
OptionsResult = yes(ModuleOptionArgs),
globals.io_get_globals(Globals, !IO),
% --invoked-by-mmc-make disables reading DEFAULT_MCFLAGS
% from the environment (DEFAULT_MCFLAGS is included in
% OptionArgs) and generation of `.d' files.
% --use-subdirs is needed because the code to install
% libraries uses `--use-grade-subdirs' and assumes the
% interface files were built with `--use-subdirs'.
(
InvokedByMmcMake = yes,
UseSubdirs = ["--use-subdirs"],
InvokedByMake = ["--invoked-by-mmc-make"]
;
InvokedByMmcMake = no,
UseSubdirs = [],
InvokedByMake = []
),
AllOptionArgs = list.condense([InvokedByMake, ModuleOptionArgs,
OptionArgs, ExtraOptions, UseSubdirs]),
handle_options(AllOptionArgs, OptionsErrors, _, _, _, !IO),
(
OptionsErrors = [_ | _],
Succeeded = no,
MaybeInfo = no,
usage_errors(OptionsErrors, !IO)
;
OptionsErrors = [],
Build(AllOptionArgs, Succeeded, Info0, Info, !IO),
MaybeInfo = yes(Info),
globals.io_set_globals(Globals, !IO)
)
).
redirect_output(_ModuleName, MaybeErrorStream, !Info, !IO) :-
% Write the output to a temporary file first, so it's easy to just print
% the part of the error file that relates to the current command. It will
% be appended to the error file later.
io.make_temp(ErrorFileName, !IO),
io.open_output(ErrorFileName, ErrorFileRes, !IO),
(
ErrorFileRes = ok(ErrorOutputStream),
MaybeErrorStream = yes(ErrorOutputStream)
;
ErrorFileRes = error(IOError),
MaybeErrorStream = no,
io.write_string("** Error opening `", !IO),
io.write_string(ErrorFileName, !IO),
io.write_string("' for output: ", !IO),
io.error_message(IOError, Msg),
io.write_string(Msg, !IO),
io.nl(!IO)
).
unredirect_output(ModuleName, ErrorOutputStream, !Info, !IO) :-
io.output_stream_name(ErrorOutputStream, TmpErrorFileName, !IO),
io.close_output(ErrorOutputStream, !IO),
io.open_input(TmpErrorFileName, TmpErrorInputRes, !IO),
(
TmpErrorInputRes = ok(TmpErrorInputStream),
module_name_to_file_name(ModuleName, ".err", do_create_dirs,
ErrorFileName, !IO),
( set.member(ModuleName, !.Info ^ error_file_modules) ->
io.open_append(ErrorFileName, ErrorFileRes, !IO)
;
io.open_output(ErrorFileName, ErrorFileRes, !IO)
),
(
ErrorFileRes = ok(ErrorFileOutputStream),
globals.io_lookup_int_option(output_compile_error_lines,
LinesToWrite, !IO),
io.output_stream(CurrentOutputStream, !IO),
io.input_stream_foldl2_io(TmpErrorInputStream,
make_write_error_char(ErrorFileOutputStream,
CurrentOutputStream), LinesToWrite, TmpFileInputRes, !IO),
(
TmpFileInputRes = ok(_)
;
TmpFileInputRes = error(_, TmpFileInputError),
io.write_string("Error reading `", !IO),
io.write_string(TmpErrorFileName, !IO),
io.write_string("': ", !IO),
io.write_string(io.error_message(TmpFileInputError), !IO),
io.nl(!IO)
),
io.close_output(ErrorFileOutputStream, !IO),
!:Info = !.Info ^ error_file_modules :=
set.insert(!.Info ^ error_file_modules, ModuleName)
;
ErrorFileRes = error(Error),
io.write_string("Error opening `", !IO),
io.write_string(TmpErrorFileName, !IO),
io.write_string("': ", !IO),
io.write_string(io.error_message(Error), !IO),
io.nl(!IO)
),
io.close_input(TmpErrorInputStream, !IO)
;
TmpErrorInputRes = error(Error),
io.write_string("Error opening `", !IO),
io.write_string(TmpErrorFileName, !IO),
io.write_string("': ", !IO),
io.write_string(io.error_message(Error), !IO),
io.nl(!IO)
),
io.remove_file(TmpErrorFileName, _, !IO).
:- pred make_write_error_char(io.output_stream::in, io.output_stream::in,
char::in, int::in, int::out, io::di, io::uo) is det.
make_write_error_char(FullOutputStream, PartialOutputStream, Char,
!LinesRemaining, !IO) :-
io.write_char(FullOutputStream, Char, !IO),
( !.LinesRemaining > 0 ->
io.write_char(PartialOutputStream, Char, !IO),
( Char = '\n' ->
!:LinesRemaining = !.LinesRemaining - 1
;
true
)
; !.LinesRemaining = 0 ->
io.output_stream_name(FullOutputStream, FullOutputFileName, !IO),
io.write_string(PartialOutputStream, "... error log truncated, see `",
!IO),
io.write_string(PartialOutputStream, FullOutputFileName, !IO),
io.write_string(PartialOutputStream, "' for the complete log.\n", !IO),
% Only write the above message once.
!:LinesRemaining = -1
;
true
).
%-----------------------------------------------------------------------------%
get_timestamp_file_timestamp(target_file(ModuleName, FileType),
MaybeTimestamp, !Info, !IO) :-
globals.io_get_globals(Globals, !IO),
( TimestampExt = timestamp_extension(Globals, FileType) ->
module_name_to_file_name(ModuleName, TimestampExt, do_not_create_dirs,
FileName, !IO)
;
module_target_to_file_name(ModuleName, FileType, do_not_create_dirs,
FileName, !IO)
),
% We should only ever look for timestamp files in the current directory.
% Timestamp files are only used when processing a module, and only modules
% in the current directory are processed.
SearchDirs = [dir.this_directory],
get_file_timestamp(SearchDirs, FileName, MaybeTimestamp, !Info, !IO).
get_dependency_timestamp(DependencyFile, MaybeTimestamp, !Info, !IO) :-
(
DependencyFile = dep_file(FileName, MaybeOption),
(
MaybeOption = yes(Option),
globals.io_lookup_accumulating_option(Option, SearchDirs, !IO)
;
MaybeOption = no,
SearchDirs = [dir.this_directory]
),
get_file_timestamp(SearchDirs, FileName, MaybeTimestamp, !Info, !IO)
;
DependencyFile = dep_target(Target),
get_target_timestamp(do_search, Target, MaybeTimestamp0, !Info, !IO),
(
Target = target_file(_, module_target_c_header(header_mih)),
MaybeTimestamp0 = ok(_)
->
% Don't rebuild the `.o' file if an irrelevant part of a
% `.mih' file has changed. If a relevant part of a `.mih'
% file changed, the interface files of the imported module
% must have changed in a way that would force the `.c' and
% `.o' files of the current module to be rebuilt.
MaybeTimestamp = ok(oldest_timestamp)
;
MaybeTimestamp = MaybeTimestamp0
)
).
get_target_timestamp(Search, TargetFile, MaybeTimestamp, !Info, !IO) :-
TargetFile = target_file(_ModuleName, FileType),
get_file_name(Search, TargetFile, FileName, !Info, !IO),
( FileType = module_target_analysis_registry ->
get_target_timestamp_analysis_registry(Search, TargetFile, FileName,
MaybeTimestamp, !Info, !IO)
;
get_target_timestamp_2(Search, TargetFile, FileName, MaybeTimestamp,
!Info, !IO)
).
% Special treatment for `.analysis' files. If the corresponding
% `.analysis_status' file says the `.analysis' file is invalid then we
% treat it as out of date.
%
:- pred get_target_timestamp_analysis_registry(maybe_search::in,
target_file::in, file_name::in, maybe_error(timestamp)::out,
make_info::in, make_info::out, io::di, io::uo) is det.
get_target_timestamp_analysis_registry(Search, TargetFile, FileName,
MaybeTimestamp, !Info, !IO) :-
TargetFile = target_file(ModuleName, _FileType),
( MaybeTimestamp0 = !.Info ^ file_timestamps ^ elem(FileName) ->
MaybeTimestamp = MaybeTimestamp0
;
analysis.read_module_overall_status(mmc, ModuleName, Status, !IO),
(
( Status = optimal
; Status = suboptimal
),
get_target_timestamp_2(Search, TargetFile, FileName,
MaybeTimestamp, !Info, !IO)
;
Status = invalid,
MaybeTimestamp = error("invalid module"),
!Info ^ file_timestamps ^ elem(FileName) := MaybeTimestamp
)
).
:- pred get_target_timestamp_2(maybe_search::in, target_file::in,
file_name::in, maybe_error(timestamp)::out, make_info::in, make_info::out,
io::di, io::uo) is det.
get_target_timestamp_2(Search, TargetFile, FileName, MaybeTimestamp,
!Info, !IO) :-
TargetFile = target_file(ModuleName, FileType),
(
Search = do_search,
get_search_directories(FileType, SearchDirs, !IO)
;
Search = do_not_search,
SearchDirs = [dir.this_directory]
),
get_file_timestamp(SearchDirs, FileName, MaybeTimestamp0, !Info, !IO),
(
MaybeTimestamp0 = error(_),
( FileType = module_target_intermodule_interface
; FileType = module_target_analysis_registry
)
->
% If a `.opt' file in another directory doesn't exist,
% it just means that a library wasn't compiled with
% `--intermodule-optimization'.
% Similarly for `.analysis' files.
get_module_dependencies(ModuleName, MaybeImports, !Info, !IO),
(
MaybeImports = yes(Imports),
Imports ^ module_dir \= dir.this_directory
->
MaybeTimestamp = ok(oldest_timestamp),
!:Info = !.Info ^ file_timestamps ^ elem(FileName)
:= MaybeTimestamp
;
MaybeTimestamp = MaybeTimestamp0
)
;
MaybeTimestamp = MaybeTimestamp0
).
get_file_name(Search, TargetFile, FileName, !Info, !IO) :-
TargetFile = target_file(ModuleName, FileType),
( FileType = module_target_source ->
% In some cases the module name won't match the file name
% (module mdb.parse might be in parse.m or mdb.m), so we need to
% look up the file name here.
get_module_dependencies(ModuleName, MaybeImports, !Info, !IO),
(
MaybeImports = yes(Imports),
FileName = Imports ^ source_file_name
;
MaybeImports = no,
% Something has gone wrong generating the dependencies,
% so just take a punt (which probably won't work).
module_name_to_file_name(ModuleName, ".m", do_not_create_dirs,
FileName, !IO)
)
;
globals.io_get_globals(Globals, !IO),
MaybeExt = target_extension(Globals, FileType),
(
MaybeExt = yes(Ext),
(
Search = do_search,
module_name_to_search_file_name_cache(ModuleName, Ext,
FileName, !Info, !IO)
;
Search = do_not_search,
% Not common enough to cache.
module_name_to_file_name(ModuleName, Ext, do_not_create_dirs,
FileName, !IO)
)
;
MaybeExt = no,
module_target_to_file_name_maybe_search(ModuleName, FileType,
do_not_create_dirs, Search, FileName, !IO)
)
).
:- pred module_name_to_search_file_name_cache(module_name::in,
string::in, string::out, make_info::in, make_info::out, io::di, io::uo)
is det.
module_name_to_search_file_name_cache(ModuleName, Ext, FileName, !Info, !IO) :-
Key = ModuleName - Ext,
( map.search(!.Info ^ search_file_name_cache, Key, FileName0) ->
FileName = FileName0
;
module_name_to_search_file_name(ModuleName, Ext, FileName, !IO),
!Info ^ search_file_name_cache ^ elem(Key) := FileName
).
get_file_timestamp(SearchDirs, FileName, MaybeTimestamp, !Info, !IO) :-
( MaybeTimestamp0 = !.Info ^ file_timestamps ^ elem(FileName) ->
MaybeTimestamp = MaybeTimestamp0
;
io.input_stream(OldInputStream, !IO),
search_for_file(SearchDirs, FileName, SearchResult, !IO),
(
SearchResult = ok(_),
io.input_stream_name(FullFileName, !IO),
io.set_input_stream(OldInputStream, FileStream, !IO),
io.close_input(FileStream, !IO),
io.file_modification_time(FullFileName, TimeTResult, !IO),
(
TimeTResult = ok(TimeT),
Timestamp = time_t_to_timestamp(TimeT),
MaybeTimestamp = ok(Timestamp)
;
TimeTResult = error(Error),
MaybeTimestamp = error(io.error_message(Error))
),
!:Info = !.Info ^ file_timestamps ^ elem(FileName)
:= MaybeTimestamp
;
SearchResult = error(_),
MaybeTimestamp = error("file `" ++ FileName ++ "' not found")
)
).
:- pred get_search_directories(module_target_type::in, list(dir_name)::out,
io::di, io::uo) is det.
get_search_directories(FileType, SearchDirs, !IO) :-
MaybeOpt = search_for_file_type(FileType),
(
MaybeOpt = yes(SearchDirOpt),
globals.io_lookup_accumulating_option(SearchDirOpt, SearchDirs0, !IO),
% Make sure the current directory is searched
% for C headers and libraries.
SearchDirs =
( list.member(dir.this_directory, SearchDirs0) ->
SearchDirs0
;
[dir.this_directory | SearchDirs0]
)
;
MaybeOpt = no,
SearchDirs = [dir.this_directory]
).
find_oldest_timestamp(error(_) @ MaybeTimestamp, _) = MaybeTimestamp.
find_oldest_timestamp(ok(_), error(_) @ MaybeTimestamp) = MaybeTimestamp.
find_oldest_timestamp(ok(Timestamp1), ok(Timestamp2)) = ok(Timestamp) :-
( compare((<), Timestamp1, Timestamp2) ->
Timestamp = Timestamp1
;
Timestamp = Timestamp2
).
%-----------------------------------------------------------------------------%
make_remove_target_file(VerboseOption, target_file(ModuleName, FileType),
!Info, !IO) :-
make_remove_target_file(VerboseOption, ModuleName, FileType, !Info, !IO).
make_remove_target_file(VerboseOption, ModuleName, FileType, !Info, !IO) :-
globals.io_get_globals(Globals, !IO),
module_target_to_file_name(ModuleName, FileType, do_not_create_dirs,
FileName, !IO),
make_remove_file(VerboseOption, FileName, !Info, !IO),
( TimestampExt = timestamp_extension(Globals, FileType) ->
make_remove_file(VerboseOption, ModuleName, TimestampExt, !Info, !IO)
;
true
).
make_remove_file(VerboseOption, ModuleName, Ext, !Info, !IO) :-
module_name_to_file_name(ModuleName, Ext, do_not_create_dirs, FileName,
!IO),
make_remove_file(VerboseOption, FileName, !Info, !IO).
make_remove_file(VerboseOption, FileName, !Info, !IO) :-
verbose_msg(VerboseOption, report_remove_file(FileName), !IO),
io.remove_file_recursively(FileName, _, !IO),
!:Info = !.Info ^ file_timestamps :=
map.delete(!.Info ^ file_timestamps, FileName).
:- pred report_remove_file(string::in, io::di, io::uo) is det.
report_remove_file(FileName, !IO) :-
io.write_string("Removing ", !IO),
io.write_string(FileName, !IO),
io.nl(!IO).
%-----------------------------------------------------------------------------%
make_target_file_list(ModuleNames, FileType) =
list.map((func(ModuleName) = target_file(ModuleName, FileType)),
ModuleNames).
make_dependency_list(ModuleNames, FileType) =
list.map((func(Module) = dep_target(target_file(Module, FileType))),
ModuleNames).
target_extension(_, module_target_source) = yes(".m").
target_extension(_, module_target_errors) = yes(".err").
target_extension(_, module_target_private_interface) = yes(".int0").
target_extension(_, module_target_long_interface) = yes(".int").
target_extension(_, module_target_short_interface) = yes(".int2").
target_extension(_, module_target_unqualified_short_interface) = yes(".int3").
target_extension(_, module_target_intermodule_interface) = yes(".opt").
target_extension(_, module_target_analysis_registry) = yes(".analysis").
target_extension(_, module_target_track_flags) = yes(".track_flags").
target_extension(_, module_target_c_header(header_mih)) = yes(".mih").
target_extension(_, module_target_c_header(header_mh)) = yes(".mh").
target_extension(_, module_target_c_code) = yes(".c").
target_extension(_, module_target_il_code) = yes(".il").
% XXX ".exe" if the module contains main.
target_extension(_, module_target_il_asm) = yes(".dll").
target_extension(_, module_target_java_code) = yes(".java").
target_extension(_, module_target_java_class_code) = yes(".class").
target_extension(_, module_target_erlang_header) = yes(".hrl").
target_extension(_, module_target_erlang_code) = yes(".erl").
target_extension(_, module_target_erlang_beam_code) = yes(".beam").
target_extension(_, module_target_asm_code(non_pic)) = yes(".s").
target_extension(_, module_target_asm_code(link_with_pic)) = yes(".s").
target_extension(_, module_target_asm_code(pic)) = yes(".pic_s").
target_extension(Globals, module_target_object_code(PIC)) = yes(Ext) :-
maybe_pic_object_file_extension(Globals, PIC, Ext).
target_extension(_, module_target_xml_doc) = yes(".xml").
% These all need to be handled as special cases.
target_extension(_, module_target_foreign_object(_, _)) = no.
target_extension(_, module_target_foreign_il_asm(_)) = no.
target_extension(_, module_target_fact_table_object(_, _)) = no.
linked_target_file_name(ModuleName, executable, FileName, !IO) :-
globals.io_lookup_string_option(executable_file_extension, Ext, !IO),
module_name_to_file_name(ModuleName, Ext,
do_not_create_dirs, FileName, !IO).
linked_target_file_name(ModuleName, static_library, FileName, !IO) :-
globals.io_lookup_string_option(library_extension, Ext, !IO),
module_name_to_lib_file_name("lib", ModuleName, Ext,
do_not_create_dirs, FileName, !IO).
linked_target_file_name(ModuleName, shared_library, FileName, !IO) :-
globals.io_lookup_string_option(shared_library_extension, Ext, !IO),
module_name_to_lib_file_name("lib", ModuleName, Ext,
do_not_create_dirs, FileName, !IO).
linked_target_file_name(ModuleName, java_archive, FileName, !IO) :-
module_name_to_file_name(ModuleName, ".jar",
do_not_create_dirs, FileName, !IO).
linked_target_file_name(ModuleName, erlang_archive, FileName, !IO) :-
module_name_to_lib_file_name("lib", ModuleName, ".beams",
do_not_create_dirs, FileName, !IO).
:- pred module_target_to_file_name(module_name::in, module_target_type::in,
maybe_create_dirs::in, file_name::out, io::di, io::uo) is det.
module_target_to_file_name(ModuleName, TargetType, MkDir, FileName, !IO) :-
module_target_to_file_name_maybe_search(ModuleName, TargetType, MkDir,
do_not_search, FileName, !IO).
:- pred module_target_to_search_file_name(module_name::in,
module_target_type::in, file_name::out, io::di, io::uo) is det.
module_target_to_search_file_name(ModuleName, TargetType, FileName, !IO) :-
module_target_to_file_name_maybe_search(ModuleName, TargetType,
do_not_create_dirs, do_search, FileName, !IO).
:- pred module_target_to_file_name_maybe_search(module_name::in,
module_target_type::in, maybe_create_dirs::in, maybe_search::in,
file_name::out, io::di, io::uo) is det.
module_target_to_file_name_maybe_search(ModuleName, TargetType, MkDir, Search,
FileName, !IO) :-
globals.io_get_globals(Globals, !IO),
target_extension(Globals, TargetType) = MaybeExt,
(
MaybeExt = yes(Ext),
(
Search = do_search,
module_name_to_search_file_name(ModuleName, Ext, FileName, !IO)
;
Search = do_not_search,
module_name_to_file_name(ModuleName, Ext, MkDir, FileName, !IO)
)
;
MaybeExt = no,
(
TargetType = module_target_foreign_object(PIC, Lang),
(
ForeignModuleName =
foreign_language_module_name(ModuleName, Lang)
->
module_target_to_file_name_maybe_search(ForeignModuleName,
module_target_object_code(PIC), MkDir, Search, FileName,
!IO)
;
unexpected(this_file, "module_target_to_file_name_2")
)
;
TargetType = module_target_foreign_il_asm(Lang),
(
ForeignModuleName =
foreign_language_module_name(ModuleName, Lang)
->
module_target_to_file_name_maybe_search(ForeignModuleName,
module_target_il_asm, MkDir, Search, FileName, !IO)
;
unexpected(this_file, "module_target_to_file_name_2")
)
;
TargetType = module_target_fact_table_object(PIC, FactFile),
maybe_pic_object_file_extension(PIC, Ext, !IO),
fact_table_file_name(ModuleName, FactFile, Ext, MkDir, FileName,
!IO)
;
( TargetType = module_target_analysis_registry
; TargetType = module_target_asm_code(_)
; TargetType = make.module_target_c_code
; TargetType = module_target_c_header(_)
; TargetType = module_target_erlang_beam_code
; TargetType = module_target_erlang_code
; TargetType = module_target_erlang_header
; TargetType = module_target_errors
; TargetType = make.module_target_il_asm
; TargetType = module_target_il_code
; TargetType = module_target_intermodule_interface
; TargetType = module_target_java_code
; TargetType = module_target_java_class_code
; TargetType = module_target_long_interface
; TargetType = module_target_object_code(_)
; TargetType = module_target_private_interface
; TargetType = module_target_short_interface
; TargetType = module_target_source
; TargetType = module_target_unqualified_short_interface
; TargetType = module_target_xml_doc
; TargetType = module_target_track_flags
),
unexpected(this_file, "module_target_to_file_name_2")
)
).
% Note that we need a timestamp file for `.err' files because
% errors are written to the `.err' file even when writing interfaces.
% The timestamp is only updated when compiling to target code.
%
% We need a timestamp file for `.analysis' files because they
% can be modified in the process of analysing _another_ module.
% The timestamp is only updated after actually analysing the module that
% the `.analysis' file corresponds to.
%
% Header files share a timestamp file with their corresponding target code
% files.
%
timestamp_extension(_, module_target_errors) = ".err_date".
timestamp_extension(_, module_target_private_interface) = ".date0".
timestamp_extension(_, module_target_long_interface) = ".date".
timestamp_extension(_, module_target_short_interface) = ".date".
timestamp_extension(_, module_target_unqualified_short_interface) = ".date3".
timestamp_extension(_, module_target_intermodule_interface) = ".optdate".
timestamp_extension(_, module_target_analysis_registry) = ".analysis_date".
timestamp_extension(_, module_target_c_code) = ".c_date".
timestamp_extension(Globals, module_target_c_header(_)) = Ext :-
globals.get_target(Globals, Target),
(
Target = target_asm,
ModuleTargetType = module_target_asm_code(non_pic)
;
% XXX Some of these alternatives don't look right.
( Target = target_c
; Target = target_x86_64
; Target = target_il
; Target = target_java
; Target = target_erlang
),
ModuleTargetType = module_target_c_code
),
Ext = timestamp_extension(Globals, ModuleTargetType).
timestamp_extension(_, module_target_il_code) = ".il_date".
timestamp_extension(_, module_target_java_code) = ".java_date".
timestamp_extension(_, module_target_erlang_code) = ".erl_date".
timestamp_extension(Globals, module_target_erlang_header) =
timestamp_extension(Globals, module_target_erlang_code).
timestamp_extension(_, module_target_asm_code(non_pic)) = ".s_date".
timestamp_extension(_, module_target_asm_code(pic)) = ".pic_s_date".
:- func search_for_file_type(module_target_type) = maybe(option).
search_for_file_type(module_target_source) = no.
search_for_file_type(module_target_errors) = no.
% XXX only for inter-module optimization.
search_for_file_type(module_target_private_interface) =
yes(search_directories).
search_for_file_type(module_target_long_interface) = yes(search_directories).
search_for_file_type(module_target_short_interface) = yes(search_directories).
search_for_file_type(module_target_unqualified_short_interface) =
yes(search_directories).
search_for_file_type(module_target_intermodule_interface) =
yes(intermod_directories).
search_for_file_type(module_target_analysis_registry) =
yes(intermod_directories).
search_for_file_type(module_target_track_flags) = no.
search_for_file_type(module_target_c_header(_)) = yes(c_include_directory).
search_for_file_type(module_target_c_code) = no.
search_for_file_type(module_target_il_code) = no.
search_for_file_type(module_target_il_asm) = no.
search_for_file_type(module_target_java_code) = no.
search_for_file_type(module_target_java_class_code) = no.
search_for_file_type(module_target_erlang_header) =
yes(erlang_include_directory).
search_for_file_type(module_target_erlang_code) = no.
search_for_file_type(module_target_erlang_beam_code) = no.
search_for_file_type(module_target_asm_code(_)) = no.
search_for_file_type(module_target_object_code(_)) = no.
search_for_file_type(module_target_foreign_object(_, _)) = no.
search_for_file_type(module_target_foreign_il_asm(_)) = no.
search_for_file_type(module_target_fact_table_object(_, _)) = no.
search_for_file_type(module_target_xml_doc) = no.
target_is_grade_or_arch_dependent(Target) :-
is_target_grade_or_arch_dependent(Target) = yes.
:- func is_target_grade_or_arch_dependent(module_target_type) = bool.
is_target_grade_or_arch_dependent(Target) = IsDependent :-
(
( Target = module_target_source
; Target = module_target_errors
; Target = module_target_private_interface
; Target = module_target_long_interface
; Target = module_target_short_interface
; Target = module_target_unqualified_short_interface
; Target = module_target_c_header(header_mh)
; Target = module_target_xml_doc
),
IsDependent = no
;
( Target = module_target_intermodule_interface
; Target = module_target_analysis_registry
; Target = module_target_track_flags
; Target = module_target_c_header(header_mih)
; Target = module_target_c_code
; Target = module_target_il_code
; Target = module_target_il_asm
; Target = module_target_java_code
; Target = module_target_java_class_code
; Target = module_target_erlang_code
; Target = module_target_erlang_beam_code
; Target = module_target_erlang_header
; Target = module_target_asm_code(_)
; Target = module_target_object_code(_)
; Target = module_target_foreign_object(_, _)
; Target = module_target_foreign_il_asm(_)
; Target = module_target_fact_table_object(_, _)
),
IsDependent = yes
).
%-----------------------------------------------------------------------------%
debug_msg(P, !IO) :-
verbose_msg(debug_make, P, !IO).
verbose_msg(P, !IO) :-
verbose_msg(verbose_make, P, !IO).
verbose_msg(Option, P, !IO) :-
globals.io_lookup_bool_option(Option, OptionValue, !IO),
(
OptionValue = yes,
P(!IO),
io.flush_output(!IO)
;
OptionValue = no
).
debug_file_msg(TargetFile, Msg, !IO) :-
debug_msg(
(pred(!.IO::di, !:IO::uo) is det :-
make_write_target_file(TargetFile, !IO),
io.write_string(": ", !IO),
io.write_string(Msg, !IO),
io.nl(!IO)
), !IO).
make_write_dependency_file(dep_target(TargetFile), !IO) :-
make_write_target_file(TargetFile, !IO).
make_write_dependency_file(dep_file(FileName, _), !IO) :-
io.write_string(FileName, !IO).
make_write_dependency_file_list([], !IO).
make_write_dependency_file_list([DepFile | DepFiles], !IO) :-
io.write_string("\t", !IO),
make_write_dependency_file(DepFile, !IO),
io.nl(!IO),
make_write_dependency_file_list(DepFiles, !IO).
make_write_target_file(TargetFile, !IO) :-
TargetFile = target_file(ModuleName, FileType),
module_target_to_file_name(ModuleName, FileType, do_not_create_dirs,
FileName, !IO),
io.write_string(FileName, !IO).
maybe_make_linked_target_message(TargetFile, !IO) :-
verbose_msg(
(pred(!.IO::di, !:IO::uo) is det :-
io.write_string("Making ", !IO),
io.write_string(TargetFile, !IO),
io.nl(!IO)
), !IO).
maybe_make_target_message(TargetFile, !IO) :-
io.output_stream(OutputStream, !IO),
maybe_make_target_message_to_stream(OutputStream, TargetFile, !IO).
maybe_make_target_message_to_stream(OutputStream, TargetFile, !IO) :-
verbose_msg(
(pred(!.IO::di, !:IO::uo) is det :-
io.set_output_stream(OutputStream, OldOutputStream, !IO),
io.write_string("Making ", !IO),
make_write_target_file(TargetFile, !IO),
io.nl(!IO),
io.set_output_stream(OldOutputStream, _, !IO)
), !IO).
maybe_reanalyse_modules_message(!IO) :-
io.output_stream(OutputStream, !IO),
verbose_msg(
(pred(!.IO::di, !:IO::uo) is det :-
io.set_output_stream(OutputStream, OldOutputStream, !IO),
io.write_string("Reanalysing invalid/suboptimal modules\n", !IO),
io.set_output_stream(OldOutputStream, _, !IO)
), !IO).
target_file_error(TargetFile, !IO) :-
io.write_string("** Error making `", !IO),
make_write_target_file(TargetFile, !IO),
io.write_string("'.\n", !IO).
file_error(TargetFile, !IO) :-
io.write_string("** Error making `", !IO),
io.write_string(TargetFile, !IO),
io.write_string("'.\n", !IO).
maybe_warn_up_to_date_target(Target, !Info, !IO) :-
globals.io_lookup_bool_option(warn_up_to_date, Warn, !IO),
(
Warn = yes,
( set.member(Target, !.Info ^ command_line_targets) ->
io.write_string("** Nothing to be done for `", !IO),
make_write_module_or_linked_target(Target, !IO),
io.write_string("'.\n", !IO)
;
true
)
;
Warn = no
),
!:Info = !.Info ^ command_line_targets :=
set.delete(!.Info ^ command_line_targets, Target).
maybe_symlink_or_copy_linked_target_message(Target, !IO) :-
verbose_msg(
(pred(!.IO::di, !:IO::uo) is det :-
io.write_string("Made symlink/copy of ", !IO),
make_write_module_or_linked_target(Target, !IO),
io.write_string("\n", !IO)
), !IO).
:- pred make_write_module_or_linked_target(pair(module_name, target_type)::in,
io::di, io::uo) is det.
make_write_module_or_linked_target(ModuleName - FileType, !IO) :-
(
FileType = module_target(ModuleTargetType),
TargetFile = target_file(ModuleName, ModuleTargetType),
make_write_target_file(TargetFile, !IO)
;
FileType = linked_target(LinkedTargetType),
linked_target_file_name(ModuleName, LinkedTargetType, FileName, !IO),
io.write_string(FileName, !IO)
;
FileType = misc_target(_),
unexpected(this_file,
"maybe_warn_up_to_date_target: misc_target")
).
%-----------------------------------------------------------------------------%
%
% Timing
%
:- pragma foreign_proc("C",
get_real_milliseconds(Time::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
"
Time = MR_get_real_milliseconds();
IO = IO0;
").
%-----------------------------------------------------------------------------%
%
% Hash functions
%
module_name_hash(SymName, Hash) :-
(
SymName = unqualified(String),
Hash = string.hash(String)
;
SymName = qualified(_Qual, String),
% Hashing the the module qualifier seems to be not worthwhile.
Hash = string.hash(String)
).
dependency_file_hash(DepFile, Hash) :-
(
DepFile = dep_target(TargetFile),
Hash = target_file_hash(TargetFile)
;
DepFile = dep_file(FileName, _MaybeOption),
Hash = string.hash(FileName)
).
:- func target_file_hash(target_file) = int.
target_file_hash(TargetFile) = Hash :-
TargetFile = target_file(ModuleName, Type),
module_name_hash(ModuleName, Hash0),
Hash1 = module_target_type_to_nonce(Type),
Hash = mix(Hash0, Hash1).
:- func module_target_type_to_nonce(module_target_type) = int.
module_target_type_to_nonce(Type) = X :-
(
Type = module_target_source,
X = 1
;
Type = module_target_errors,
X = 2
;
Type = module_target_private_interface,
X = 3
;
Type = module_target_long_interface,
X = 4
;
Type = module_target_short_interface,
X = 5
;
Type = module_target_unqualified_short_interface,
X = 6
;
Type = module_target_intermodule_interface,
X = 7
;
Type = module_target_analysis_registry,
X = 8
;
Type = module_target_c_header(header_mh),
X = 9
;
Type = module_target_c_header(header_mih),
X = 10
;
Type = module_target_c_code,
X = 11
;
Type = module_target_il_code,
X = 12
;
Type = module_target_il_asm,
X = 13
;
Type = module_target_java_code,
X = 14
;
Type = module_target_erlang_header,
X = 15
;
Type = module_target_erlang_code,
X = 16
;
Type = module_target_erlang_beam_code,
X = 17
;
Type = module_target_asm_code(_PIC),
X = 18
;
Type = module_target_object_code(PIC),
X = 19 `mix` pic_to_nonce(PIC)
;
Type = module_target_foreign_il_asm(_ForeignLang),
X = 20
;
Type = module_target_foreign_object(_PIC, _ForeignLang),
X = 21
;
Type = module_target_fact_table_object(_PIC, _FileName),
X = 22
;
Type = module_target_xml_doc,
X = 23
;
Type = module_target_track_flags,
X = 24
;
Type = module_target_java_class_code,
X = 25
).
:- func pic_to_nonce(pic) = int.
pic_to_nonce(pic) = 1.
pic_to_nonce(link_with_pic) = 2.
pic_to_nonce(non_pic) = 3.
:- func mix(int, int) = int.
mix(H0, X) = H :-
H1 = H0 `xor` (H0 `unchecked_left_shift` 5),
H = H1 `xor` X.
:- func concoct_second_hash(int) = int.
concoct_second_hash(H) = mix(H, 0xfe3dbe7f). % whatever
%-----------------------------------------------------------------------------%
:- func this_file = string.
this_file = "make.util.m".
%-----------------------------------------------------------------------------%
:- end_module make.util.
%-----------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink