mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-30 08:44:37 +00:00
Code Issues Projects Releases Wiki Activity
Files
dcf78c3447bd35fd56dbdc8797fa654339a94271
mercury/compiler/make.util.m
Zoltan Somogyi e854a5f9d9 Major improvements to tabling, of two types. 
Estimated hours taken: 32
Branches: main

Major improvements to tabling, of two types. The first is the implementation
of the loopcheck and memo forms of tabling for model_non procedures, and the
second is a start on the implementation of a new method of implementing
minimal model tabling, one that has the potential for a proper fix of the
problem that we currently merely detect with the pneg stack (the detection
is followed by a runtime abort). Since this new method relies on giving each
own generator its own stack, the grade component denoting it is "mmos"
(minimal model own stack). The true name of the existing method is changed
from "mm" to "mmsc" (minimal model stack copy). The grade component "mm"
is now a shorthand for "mmsc"; when the new method works, "mm" will be changed
to be a shorthand for "mmos".

configure.in:
scripts/canonical_grade.sh-subr:
scripts/init_grade_options.sh-subr:
scripts/parse_grade_options.sh-subr:
scripts/final_grade_options.sh-subr:
compiler/options.m:
	Handle the new way of handling minimal model grades.

scripts/mgnuc.in:
compiler/compile_target_code.m:
	Conform to the changes in minimal model grade options.

compiler/table_gen.m:
	Implement the transformations required by the loopcheck and memo
	tabling of model_non procedures, and the minimal model own stack
	transformation.

	The new implementation transformations use foreign_procs with extra
	args, since there is no point in implementing them both that way and
	with separate calls to library predicates. This required making the
	choice of which method to use at the top level of each transformation.

	Fix an oversight that hasn't caused problems yet but may in the future:
	mark goals wrapping the original goals as not impure for determinism
	computations.

compiler/handle_options.m:
	Handle the new arrangement of the options for minimal model tabling.
	Detect simultaneous calls for both forms of minimal model tabling,
	and generate an error message. Allow for more than one error message
	generated at once; report them all once rather than separately.

compiler/globals.m:
	Add a mechanism to allow a fix a problem detected by the changes
	to handle_options: the fact that we currently may generate a usage
	message more than once for invocations with more than one error.

compiler/mercury_compile.m:
compiler/make.program_target.m:
compiler/make.util.m:
	Use the new mechanism in handle_options to avoid generating duplicate
	usage messages.

compiler/error_util.m:
	Add a utility predicate for use by handle_options.

compiler/hlds_pred.m:
	Allow memo tabling for model_non predicates, and handle own stack
	tabling.

compiler/hlds_out.m:
	Print information about the modes of the arguments of foreign_procs,
	since this is useful in debugging transformations such as tabling
	that generate them.

compiler/prog_data.m:
compiler/layout_out.m:
compiler/prog_out.m:
runtime/mercury_stack_layout.h:
	Mention the new evaluation method.

compiler/goal_util.m:
	Change the predicates for creating calls and foreign_procs to allow
	more than one goal feature to be attached to the new goal. table_gen.m
	now uses this capability.

compiler/add_heap_ops.m:
compiler/add_trail_ops.m:
compiler/polymorphism.m:
compiler/simplify.m:
compiler/size_prof.m:
compiler/typecheck.m:
compiler/unify_proc.m:
	Conform to the changes in goal_util.

compiler/code_info.m:
compiler/make_hlds.m:
compiler/modules.m:
compiler/prog_io_pragma.m:
	Conform to the new the options controlling minimal model
	tabling.

compiler/prog_util.m:
	Add a utility predicate for use by table_gen.m.

library/std_util.m:
	Conform to the changes in the macros for minimal model tabling grades.

library/table_builtin.m:
	Add the types and predicates required by the new transformations.

	Delete an obsolete comment.

runtime/mercury_grade.h:
	Handle the new minimal model grade component.

runtime/mercury_conf_param.h:
	List macros controlling minimal model grades.

runtime/mercury_tabling.[ch]:
	Define the types needed by the new transformations,

	Implement the performance-critical predicates that need to be
	hand-written for memo tabling of model_non predicates.

	Add utility predicates for debugging.

runtime/mercury_tabling_preds.h:
	Add the implementations of the predicates required by the new
	transformations.

runtime/mercury_mm_own_stacks.[ch]:
	This new module contains the first draft of the implementation
	of the own stack implementation of minimal model tabling.

runtime/mercury_imp.h:
	Include the new file if the grade needs it.

runtime/Mmakefile:
	Mention the new files, and sort the lists of filenames.

runtime/mercury_tabling_macros.h:
	Add a macro for allocating answer blocks without requiring them to be
	pointed to directly by trie nodes.

runtime/mercury_minimal_model.[ch]:
	The structure type holding answer lists is now in mercury_tabling.h,
	since it is now also needed by memo tabling of model_non predicates.
	It no longer has a field for an answer num, because while it is ok
	to require a separate grade for debugging minimal model tabling,
	it is not ok to require a separate grade for debugging memo tabling
	of model_non predicates. Instead of printing the answer numbers,
	print the answers themselves when we need to identify solutions
	for debugging.

	Change function names, macro names, error messages etc where this is
	useful to distinguish the two kinds of minimal model tabling.

	Fix some oversights wrt transient registers.

runtime/mercury_context.[ch]:
runtime/mercury_engine.[ch]:
runtime/mercury_memory.[ch]:
runtime/mercury_wrapper.[ch]:
	With own stack tabling, each subgoal has its own context, so record
	the identity of the subgoal owning a context in the context itself.
	The main computation's context is the exception: it has no owner.

	Record not just the main context, but also the contexts of subgoals
	in the engine.

	Add variables for holding the sizes of the det and nondet stacks
	of the contexts of subgoals (which should in general be smaller
	than the sizes of the corresponding stacks of the main context),
	and initialize them as needed.

	Initialize the variables holding the sizes of the gen, cut and pneg
	stacks, even in grades where the stacks are not used, for safety.

	Fix some out-of-date documentation, and conform to our coding
	guidelines.

runtime/mercury_memory_zones.[ch]:
	Add a function to test whether a pointer is in a zone, to help
	debugging.

runtime/mercury_debug.[ch]:
	Add some functions to help debugging in the presence of multiple
	contexts, and factor out some common code to help with this.

	Delete the obsolete, unused function MR_printdetslot_as_label.

runtime/mercury_context.h:
runtime/mercury_bootstrap.h:
	Move a bootstrapping #define from mercury_context.h to
	mercury_bootstrap.h.

runtime/mercury_context.h:
runtime/mercury_bootstrap.h:
	Move a bootstrapping #define from mercury_context.h to
	mercury_bootstrap.h.

runtime/mercury_types.h:
	Add some more forward declarations of type names.

runtime/mercury_dlist.[ch]:
	Rename a field to avoid assignments that dereference NULL.

runtime/mercury_debug.c:
runtime/mercury_memory.c:
runtime/mercury_ml_expand_body.h:
runtime/mercury_stack_trace.c:
runtime/mercury_stacks.[ch]:
trace/mercury_trace_util.c
	Update uses of the macros that control minimal model tabling.

runtime/mercury_stack_trace.c:
	Provide a mechanism to allow stack traces to be suppressed entirely.
	The intention is that by using this mechanism, by the testing system
	won't have to provide separate .exp files for hlc grades, nondebug
	LLDS grades and debug LLDS grades, as we do currently. The mechanism
	is the environment variable MERCURY_SUPPRESS_STACK_TRACE.

tools/bootcheck:
tools/test_mercury:
	Specify MERCURY_SUPPRESS_STACK_TRACE.

trace/mercury_trace.c:
	When performing retries across tabled calls, handle memo tabled
	model_non predicates, for which the call table tip variable holds
	a record with a back pointer to a trie node, instead of the trie node
	itself.

trace/mercury_trace_internal.c:
	When printing tables, handle memo tabled model_non predicates. Delete
	the code now moved to runtime/mercury_tabling.c.

	Add functions for printing the data structures for own stack minimal
	model tabling.

tests/debugger/print_table.{m,inp,exp}:
	Update this test case to also test the printing of tables for
	memo tabled model_non predicates.

tests/debugger/retry.{m,inp,exp}:
	Update this test case to also test retries across memo tabled
	model_non predicates.

tests/tabling/loopcheck_nondet.{m,exp}:
tests/tabling/loopcheck_nondet_non_loop.{m,exp}:
	New test cases to test loopcheck tabled model_non predicates.
	One test case has a loop to detect, one doesn't.

tests/tabling/memo_non.{m,exp}:
tests/tabling/tc_memo.{m,exp}:
tests/tabling/tc_memo2.{m,exp}:
	New test cases to test memo tabled model_non predicates.
	One test case has a loop to detect, one has a need for minimal model
	tabling to detect, and the third doesn't have either.

tests/tabling/Mmakefile:
	Add the new test cases, and reenable the existing tc_loop test case.

	Rename some make variables and targets to make them better reflect
	their meaning.

tests/tabling/test_mercury:
	Conform to the change in the name of the make target.
2004-07-20 04:41:55 +00:00

974 lines
33 KiB
Mathematica
Raw Blame History

%-----------------------------------------------------------------------------%
% Copyright (C) 2002-2004 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, Info0, 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, Acc0, Acc, Info0, 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, Acc0, Acc, Info0, 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.
%-----------------------------------------------------------------------------%
:- 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, Info0, 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(ModuleName, OptionsVariables,
% OptionArgs, ExtraArgs, Builder, Succeeded, Info0, 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(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 `yes' if the file could be part of an
% installed library.
:- pred get_target_timestamp(bool::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 `yes' if the file could be part of an
% installed library.
:- pred get_file_name(bool::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.
% Remove the target file and the corresponding timestamp file.
:- pred remove_target_file(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 remove_target_file(module_name::in, module_target_type::in,
make_info::in, make_info::out, io::di, io::uo) is det.
% remove_file(ModuleName, Extension, Info0, Info).
:- pred remove_file(module_name::in, string::in, make_info::in, make_info::out,
io::di, io::uo) is det.
:- pred remove_file(file_name::in, make_info::in, make_info::out,
io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
:- func make_target_list(list(K), V) = assoc_list(K, V).
:- 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.
:- 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.
:- pred verbose_msg(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 write_dependency_file(dependency_file::in, io::di, io::uo) is det.
:- pred 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(io__output_stream::in, target_file::in,
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.
%-----------------------------------------------------------------------------%
:- implementation.
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
).
%-----------------------------------------------------------------------------%
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(yes, ModuleName, !.Info ^ options_variables,
!.Info ^ option_args, ExtraOptions, Build, Succeeded,
!.Info, MaybeInfo, !IO),
(
MaybeInfo = yes(!:Info)
;
MaybeInfo = no
).
build_with_module_options(ModuleName, OptionVariables,
OptionArgs, ExtraOptions, Build, Succeeded, !Info, !IO) :-
build_with_module_options(no, ModuleName, OptionVariables,
OptionArgs, ExtraOptions, Build, Succeeded, !Info, !IO).
:- pred build_with_module_options(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(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"]
;
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(unsafe_promise_unique(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", yes,
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,
write_error_char(ErrorFileOutputStream,
CurrentOutputStream, LinesToWrite),
0, 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 write_error_char(io__output_stream::in, io__output_stream::in,
int::in, char::in, int::in, int::out, io::di, io::uo) is det.
write_error_char(FullOutputStream, PartialOutputStream, LineLimit,
Char, !Lines, !IO) :-
io__write_char(FullOutputStream, Char, !IO),
( !.Lines < LineLimit ->
io__write_char(PartialOutputStream, Char, !IO)
;
true
),
( Char = '\n' ->
!:Lines = !.Lines + 1
;
true
).
%-----------------------------------------------------------------------------%
get_timestamp_file_timestamp(ModuleName - FileType,
MaybeTimestamp, !Info, !IO) :-
globals__io_get_globals(Globals, !IO),
( TimestampExt = timestamp_extension(Globals, FileType) ->
module_name_to_file_name(ModuleName, TimestampExt, no,
FileName, !IO)
;
module_target_to_file_name(ModuleName, FileType, no,
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(file(FileName, MaybeOption), MaybeTimestamp,
!Info, !IO) :-
(
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).
get_dependency_timestamp(target(Target), MaybeTimestamp, !Info, !IO) :-
get_target_timestamp(yes, Target, MaybeTimestamp0, !Info, !IO),
(
Target = _ - c_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, ModuleName - FileType, MaybeTimestamp,
!Info, !IO) :-
get_file_name(Search, ModuleName - FileType, FileName, !Info, !IO),
(
Search = yes,
get_search_directories(FileType, SearchDirs, !IO)
;
Search = no,
SearchDirs = [dir__this_directory]
),
get_file_timestamp(SearchDirs, FileName, MaybeTimestamp0, !Info, !IO),
(
MaybeTimestamp0 = error(_),
FileType = intermodule_interface
->
%
% If a `.opt' file in another directory doesn't exist,
% it just means that a library wasn't compiled with
% `--intermodule-optimization'.
%
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, ModuleName - FileType, FileName, !Info, !IO) :-
( FileType = 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",
no, FileName, !IO)
)
;
globals__io_get_globals(Globals, !IO),
MaybeExt = target_extension(Globals, FileType),
(
MaybeExt = yes(Ext),
(
Search = yes,
module_name_to_search_file_name(ModuleName,
Ext, FileName, !IO)
;
Search = no,
module_name_to_file_name(ModuleName,
Ext, no, FileName, !IO)
)
;
MaybeExt = no,
module_target_to_file_name(ModuleName, FileType,
no, Search, FileName, !IO)
)
).
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
;
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) :-
( yes(SearchDirOpt) = search_for_file_type(FileType) ->
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]
)
;
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
).
%-----------------------------------------------------------------------------%
remove_target_file(ModuleName - FileType, !Info, !IO) :-
remove_target_file(ModuleName, FileType, !Info, !IO).
remove_target_file(ModuleName, FileType, !Info, !IO) :-
globals__io_get_globals(Globals, !IO),
module_target_to_file_name(ModuleName, FileType, no, FileName, !IO),
remove_file(FileName, !Info, !IO),
( TimestampExt = timestamp_extension(Globals, FileType) ->
remove_file(ModuleName, TimestampExt, !Info, !IO)
;
true
).
remove_file(ModuleName, Ext, !Info, !IO) :-
module_name_to_file_name(ModuleName, Ext, no, FileName, !IO),
remove_file(FileName, !Info, !IO).
remove_file(FileName, !Info, !IO) :-
io__remove_file(FileName, _, !IO),
!:Info = !.Info ^ file_timestamps :=
map__delete(!.Info ^ file_timestamps, FileName).
%-----------------------------------------------------------------------------%
make_target_list(Ks, V) = list__map((func(K) = K - V), Ks).
make_dependency_list(ModuleNames, FileType) =
list__map((func(Module) = target(Module - FileType)), ModuleNames).
target_extension(_, source) = yes(".m").
target_extension(_, errors) = yes(".err").
target_extension(_, private_interface) = yes(".int0").
target_extension(_, long_interface) = yes(".int").
target_extension(_, short_interface) = yes(".int2").
target_extension(_, unqualified_short_interface) = yes(".int3").
target_extension(_, intermodule_interface) = yes(".opt").
target_extension(_, aditi_code) = yes(".rlo").
target_extension(_, c_header(mih)) = yes(".mih").
target_extension(_, c_header(mh)) = yes(".mh").
target_extension(_, c_code) = yes(".c").
target_extension(_, il_code) = yes(".il").
% XXX ".exe" if the module contains main.
target_extension(_, il_asm) = yes(".dll").
target_extension(_, java_code) = yes(".java").
target_extension(_, asm_code(non_pic)) = yes(".s").
target_extension(_, asm_code(link_with_pic)) = yes(".s").
target_extension(_, asm_code(pic)) = yes(".pic_s").
target_extension(Globals, object_code(PIC)) = yes(Ext) :-
maybe_pic_object_file_extension(Globals, PIC, Ext).
% These all need to be handled as special cases.
target_extension(_, foreign_object(_, _)) = no.
target_extension(_, foreign_il_asm(_)) = no.
target_extension(_, fact_table_object(_, _)) = no.
linked_target_file_name(ModuleName, executable, FileName) -->
globals__io_lookup_string_option(executable_file_extension, Ext),
module_name_to_file_name(ModuleName, Ext, no, FileName).
linked_target_file_name(ModuleName, static_library, FileName) -->
globals__io_lookup_string_option(library_extension, Ext),
module_name_to_lib_file_name("lib", ModuleName, Ext, no, FileName).
linked_target_file_name(ModuleName, shared_library, FileName) -->
globals__io_lookup_string_option(shared_library_extension, Ext),
module_name_to_lib_file_name("lib", ModuleName, Ext, no, FileName).
linked_target_file_name(ModuleName, java_archive, FileName) -->
module_name_to_file_name(ModuleName, ".jar", no, FileName).
:- pred module_target_to_file_name(module_name::in, module_target_type::in,
bool::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(ModuleName, TargetType, MkDir, no,
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(ModuleName, TargetType, no, yes, FileName,
!IO).
:- pred module_target_to_file_name(module_name::in, module_target_type::in,
bool::in, bool::in, file_name::out, io::di, io::uo) is det.
module_target_to_file_name(ModuleName, TargetType, MkDir, Search, FileName,
!IO) :-
globals__io_get_globals(Globals, !IO),
target_extension(Globals, TargetType) = MaybeExt,
(
MaybeExt = yes(Ext),
(
Search = yes,
module_name_to_search_file_name(ModuleName, Ext,
FileName, !IO)
;
Search = no,
module_name_to_file_name(ModuleName, Ext,
MkDir, FileName, !IO)
)
;
MaybeExt = no,
( TargetType = foreign_object(PIC, Lang) ->
(
ForeignModuleName =
foreign_language_module_name(
ModuleName, Lang)
->
module_target_to_file_name(ForeignModuleName,
object_code(PIC), MkDir, Search,
FileName, !IO)
;
error("module_target_to_file_name_2")
)
; TargetType = foreign_il_asm(Lang) ->
(
ForeignModuleName =
foreign_language_module_name(
ModuleName, Lang)
->
module_target_to_file_name(ForeignModuleName,
il_asm, MkDir, Search, FileName, !IO)
;
error("module_target_to_file_name_2")
)
; TargetType = fact_table_object(PIC, FactFile) ->
maybe_pic_object_file_extension(PIC, Ext, !IO),
fact_table_file_name(ModuleName, FactFile, Ext,
MkDir, FileName, !IO)
;
error("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.
timestamp_extension(_, errors) = ".err_date".
timestamp_extension(_, private_interface) = ".date0".
timestamp_extension(_, long_interface) = ".date".
timestamp_extension(_, short_interface) = ".date".
timestamp_extension(_, unqualified_short_interface) = ".date3".
timestamp_extension(_, intermodule_interface) = ".optdate".
timestamp_extension(_, c_code) = ".c_date".
timestamp_extension(Globals, c_header(_)) = Ext :-
globals__get_target(Globals, Target),
Ext = timestamp_extension(Globals,
(Target = asm -> asm_code(non_pic) ; c_code)).
timestamp_extension(_, il_code) = ".il_date".
timestamp_extension(_, java_code) = ".java_date".
timestamp_extension(_, asm_code(non_pic)) = ".s_date".
timestamp_extension(_, asm_code(pic)) = ".pic_s_date".
:- func search_for_file_type(module_target_type) = maybe(option).
search_for_file_type(source) = no.
search_for_file_type(errors) = no.
% XXX only for inter-module optimization.
search_for_file_type(private_interface) = yes(search_directories).
search_for_file_type(long_interface) = yes(search_directories).
search_for_file_type(short_interface) = yes(search_directories).
search_for_file_type(unqualified_short_interface) = yes(search_directories).
search_for_file_type(intermodule_interface) = yes(intermod_directories).
search_for_file_type(aditi_code) = no.
search_for_file_type(c_header(_)) = yes(c_include_directory).
search_for_file_type(c_code) = no.
search_for_file_type(il_code) = no.
search_for_file_type(il_asm) = no.
search_for_file_type(java_code) = no.
search_for_file_type(asm_code(_)) = no.
search_for_file_type(object_code(_)) = no.
search_for_file_type(foreign_object(_, _)) = no.
search_for_file_type(foreign_il_asm(_)) = no.
search_for_file_type(fact_table_object(_, _)) = no.
target_is_grade_or_arch_dependent(Target) :-
target_is_grade_or_arch_dependent(Target, yes).
:- pred target_is_grade_or_arch_dependent(module_target_type::in,
bool::out) is det.
target_is_grade_or_arch_dependent(source, no).
target_is_grade_or_arch_dependent(errors, no).
target_is_grade_or_arch_dependent(private_interface, no).
target_is_grade_or_arch_dependent(long_interface, no).
target_is_grade_or_arch_dependent(short_interface, no).
target_is_grade_or_arch_dependent(unqualified_short_interface, no).
target_is_grade_or_arch_dependent(intermodule_interface, yes).
target_is_grade_or_arch_dependent(aditi_code, no).
target_is_grade_or_arch_dependent(c_header(mh), no).
target_is_grade_or_arch_dependent(c_header(mih), yes).
target_is_grade_or_arch_dependent(c_code, yes).
target_is_grade_or_arch_dependent(il_code, yes).
target_is_grade_or_arch_dependent(il_asm, yes).
target_is_grade_or_arch_dependent(java_code, yes).
target_is_grade_or_arch_dependent(asm_code(_), yes).
target_is_grade_or_arch_dependent(object_code(_), yes).
target_is_grade_or_arch_dependent(foreign_object(_, _), yes).
target_is_grade_or_arch_dependent(foreign_il_asm(_), yes).
target_is_grade_or_arch_dependent(fact_table_object(_, _), yes).
%-----------------------------------------------------------------------------%
debug_msg(P, !IO) :-
globals__io_lookup_bool_option(debug_make, Debug, !IO),
(
Debug = yes,
P(!IO),
io__flush_output(!IO)
;
Debug = no
).
verbose_msg(P, !IO) :-
globals__io_lookup_bool_option(verbose_make, Verbose, !IO),
(
Verbose = yes,
P(!IO),
io__flush_output(!IO)
;
Verbose = no
).
debug_file_msg(TargetFile, Msg, !IO) :-
debug_msg(
(pred(di, uo) is det -->
write_target_file(TargetFile),
io__write_string(": "),
io__write_string(Msg),
io__nl
), !IO).
write_dependency_file(target(TargetFile), !IO) :-
write_target_file(TargetFile, !IO).
write_dependency_file(file(FileName, _), !IO) :-
io__write_string(FileName, !IO).
write_target_file(ModuleName - FileType, !IO) :-
module_target_to_file_name(ModuleName, FileType, no, FileName, !IO),
io__write_string(FileName, !IO).
maybe_make_linked_target_message(TargetFile, !IO) :-
verbose_msg(
(pred(di, uo) is det -->
io__write_string("Making "),
io__write_string(TargetFile),
io__nl
), !IO).
maybe_make_target_message(TargetFile, !IO) :-
io__output_stream(OutputStream, !IO),
maybe_make_target_message(OutputStream, TargetFile, !IO).
maybe_make_target_message(OutputStream, TargetFile, !IO) :-
verbose_msg(
(pred(di, uo) is det -->
io__set_output_stream(OutputStream, OldOutputStream),
io__write_string("Making "),
write_target_file(TargetFile),
io__nl,
io__set_output_stream(OldOutputStream, _)
), !IO).
target_file_error(TargetFile, !IO) :-
io__write_string("** Error making `", !IO),
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 @ (ModuleName - FileType), !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),
(
FileType = module_target(ModuleTargetType),
write_target_file(ModuleName -
ModuleTargetType, !IO)
;
FileType = linked_target(LinkedTargetType),
linked_target_file_name(ModuleName,
LinkedTargetType, FileName, !IO),
io__write_string(FileName, !IO)
;
FileType = misc_target(_),
error("maybe_warn_up_to_date_target: " ++
"misc_target")
),
io__write_string("'.\n", !IO)
;
true
)
;
Warn = no
),
!:Info = !.Info ^ command_line_targets :=
set__delete(!.Info ^ command_line_targets, Target).
%-----------------------------------------------------------------------------%
:- func this_file = string.
this_file = "make.util.m".
%-----------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink