mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-17 18:33:58 +00:00
Code Issues Projects Releases Wiki Activity
Files
083d376e6598628362ee91c2da170febd83590f4
mercury/compiler/recompilation.check.m
Zoltan Somogyi b6178ef723 Delete prog_out.m, moving its code to other modules. 
compiler/parse_tree_out_cons_id.m:
    Move the predicates and functions in prog_out.m that deal with cons_ids
    to this module.

compiler/parse_tree_out_sym_name.m:
    Move the predicates and functions in prog_out.m that deal with sym_names
    and similar entities to this module.

compiler/parse_tree_out_type.m:
    Move the predicates and functions in prog_out.m that deal with types
    to this module.

compiler/parse_tree_out_misc.m:
    Move the predicates and functions in prog_out.m that deal with simple
    types to this module.

    Delete mercury_output_det and mercury_format_det, replacing all their
    uses with calls to mercury_det_to_string.

compiler/prog_out.m:
    Delete this module.

compiler/parse_tree.m:
    Delete prog_out from the parse_tree package.

compiler/Mercury.options:
compiler/notes/compiler_design.html:
    Delete references to prog_out.m.

compiler/*.m:
    Update imports and any explicit module qualifications to account
    for the moved code.

tools/filter_sort_imports:
    Automatically filter out any repeated imports. This can help with
    changes like this that redistribute the contents of one module to other
    modules. In this case, after a global replacement of prog_out's import
    with the import of parse_tree_out_misc, this updated script could
    remove this changed import from modules that already imported
    parse_tree_out_misc.
2023-04-09 16:23:13 +10:00

1784 lines
75 KiB
Mathematica
Raw Blame History

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2002-2011 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%---------------------------------------------------------------------------%
%
% File: recompilation_check.m.
% Main author: stayl.
%
% Check whether a module should be recompiled.
%
%---------------------------------------------------------------------------%
:- module recompilation.check.
:- interface.
:- import_module libs.
:- import_module libs.file_util.
:- import_module libs.globals.
:- import_module mdbcomp.
:- import_module mdbcomp.sym_name.
:- import_module parse_tree.
:- import_module parse_tree.read_modules.
:- import_module io.
:- import_module list.
%---------------------------------------------------------------------------%
:- type modules_to_recompile
---> all_modules
; some_modules(list(module_name)).
:- type find_target_file_names == pred(module_name, list(file_name), io, io).
:- inst find_target_file_names == (pred(in, out, di, uo) is det).
:- type find_timestamp_file_names ==
pred(module_name, list(file_name), io, io).
:- inst find_timestamp_file_names ==
(pred(in, out, di, uo) is det).
% should_recompile(Globals, ModuleName, FindTargetFiles,
% FindTimestampFiles, ModulesToRecompile, HaveReadModuleMaps)
%
% Process the `.used' files for the given module and all its
% inline submodules to find out which modules need to be recompiled.
% `FindTargetFiles' takes a module name and returns a list of
% file names which need to be up-to-date to avoid recompilation.
% `FindTimestampFiles' takes a module name and returns a list of
% file names which should be touched if the module does not need
% to be recompiled.
% `ReadModules' is the list of interface files read during
% recompilation checking, returned to avoid rereading them
% if recompilation is required.
%
:- pred should_recompile(globals::in, module_name::in,
find_target_file_names::in(find_target_file_names),
find_timestamp_file_names::in(find_timestamp_file_names),
modules_to_recompile::out,
have_read_module_maps::in, have_read_module_maps::out,
io::di, io::uo) is det.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module hlds.
:- import_module hlds.hlds_cons. % for type field_access_type
:- import_module hlds.hlds_pred. % for field_access_function_name,
% type pred_id.
:- import_module libs.options.
:- import_module libs.timestamp.
:- import_module parse_tree.error_spec.
:- import_module parse_tree.file_kind.
:- import_module parse_tree.file_names.
:- import_module parse_tree.item_util.
:- import_module parse_tree.module_baggage.
:- import_module parse_tree.module_cmds.
:- import_module parse_tree.parse_error.
:- import_module parse_tree.parse_tree_out_misc.
:- import_module parse_tree.parse_tree_out_sym_name.
:- import_module parse_tree.prog_item.
:- import_module parse_tree.prog_util.
:- import_module parse_tree.write_error_spec.
:- import_module recompilation.used_file.
:- import_module assoc_list.
:- import_module bool.
:- import_module int.
:- import_module io.file.
:- import_module map.
:- import_module maybe.
:- import_module one_or_more.
:- import_module pair.
:- import_module require.
:- import_module set.
:- import_module string.
:- import_module term.
%---------------------------------------------------------------------------%
should_recompile(Globals, ModuleName, FindTargetFiles, FindTimestampFiles,
ModulesToRecompile, HaveReadModuleMaps0, HaveReadModuleMaps, !IO) :-
globals.lookup_bool_option(Globals, find_all_recompilation_reasons,
FindAll),
ResolvedUsedItems0 = init_resolved_used_items,
Info0 = recompilation_check_info(ModuleName, no, [], HaveReadModuleMaps0,
ResolvedUsedItems0, set.init, some_modules([]), FindAll, []),
% XXX How do we know ModuleName is not an inline submodule?
should_recompile_2(Globals, is_not_inline_submodule, FindTargetFiles,
FindTimestampFiles, ModuleName, Info0, Info, !IO),
ModulesToRecompile = Info ^ rci_modules_to_recompile,
HaveReadModuleMaps = Info ^ rci_have_read_module_maps.
:- type maybe_is_inline_submodule
---> is_not_inline_submodule
; is_inline_submodule.
:- pred should_recompile_2(globals::in, maybe_is_inline_submodule::in,
find_target_file_names::in(find_target_file_names),
find_timestamp_file_names::in(find_timestamp_file_names), module_name::in,
recompilation_check_info::in, recompilation_check_info::out,
io::di, io::uo) is det.
should_recompile_2(Globals, IsSubModule, FindTargetFiles, FindTimestampFiles,
ModuleName, !Info, !IO) :-
!Info ^ rci_module_name := ModuleName,
!Info ^ rci_sub_modules := [],
read_used_file_for_module(Globals, ModuleName, ReadUsedFileResult, !IO),
(
ReadUsedFileResult = used_file_ok(UsedFile),
should_recompile_3(Globals, UsedFile, IsSubModule, FindTargetFiles,
MaybeStoppingReason, !Info, !IO),
(
MaybeStoppingReason = no,
Reasons = !.Info ^ rci_recompilation_reasons
;
MaybeStoppingReason = yes(StoppingReason),
% Ignoring the old contents of the rci_recompilation_reasons field
% in favor of the stopping reason preserves old behavior.
% (We used to throw an exception containing StoppingReason,
% and we used to ignore the contents of rci_collect_all_reasons
% when catching that exception.)
Reasons = [StoppingReason]
),
get_progress_output_stream(Globals, ModuleName, ProgressStream, !IO),
(
Reasons = [],
FindTimestampFiles(ModuleName, TimestampFiles, !IO),
maybe_write_recompilation_message(Globals, ProgressStream,
write_not_recompiling_message(ModuleName), !IO),
get_error_output_stream(Globals, ModuleName, ErrorStream, !IO),
list.map_foldl(
touch_datestamp(Globals, ProgressStream, ErrorStream),
TimestampFiles, _Succeededs, !IO)
;
Reasons = [_ | _],
add_module_to_recompile(ModuleName, !Info),
maybe_write_recompilation_message(Globals, ProgressStream,
write_reasons_message(Globals, ModuleName,
list.reverse(Reasons)),
!IO)
),
ModulesToRecompile = !.Info ^ rci_modules_to_recompile,
(
ModulesToRecompile = all_modules
;
ModulesToRecompile = some_modules(_),
% XXX How does this piece of code justify the jump from
% "not all modules should be recompiled" to "must recompile
% !.Info ^ rci_sub_modules"?
!Info ^ rci_is_inline_sub_module := yes,
list.foldl2(
should_recompile_2(Globals, is_inline_submodule,
FindTargetFiles, FindTimestampFiles),
!.Info ^ rci_sub_modules, !Info, !IO)
)
;
ReadUsedFileResult = used_file_error(UsedFileError),
get_error_output_stream(Globals, ModuleName, ErrorStream, !IO),
maybe_write_recompilation_message(Globals, ErrorStream,
write_used_file_error(Globals, ModuleName, UsedFileError),
!IO),
!Info ^ rci_modules_to_recompile := all_modules
).
:- pred write_not_recompiling_message(module_name::in,
io.text_output_stream::in, io::di, io::uo) is det.
write_not_recompiling_message(ModuleName, Stream, !IO) :-
io.format(Stream, "Not recompiling module %s.\n",
[s(sym_name_to_escaped_string(ModuleName))], !IO).
:- pred write_reasons_message(globals::in, module_name::in,
list(recompile_reason)::in, io.text_output_stream::in,
io::di, io::uo) is det.
write_reasons_message(Globals, ModuleName, Reasons, Stream, !IO) :-
list.foldl(write_recompile_reason(Globals, Stream, ModuleName),
Reasons, !IO).
:- pred write_used_file_error(globals::in, module_name::in,
used_file_error::in, io.text_output_stream::in, io::di, io::uo) is det.
write_used_file_error(Globals, ModuleName, UsedFileError, Stream, !IO) :-
PrefixPieces = [words("Recompiling module"), qual_sym_name(ModuleName),
suffix(":"), nl],
(
UsedFileError = uf_read_error(FileName, _IOError),
% ZZZ _IOError
Pieces = [words("file"), quote(FileName), words("not found."), nl],
Spec = simplest_no_context_spec($pred, severity_informational,
phase_read_files, PrefixPieces ++ Pieces)
;
UsedFileError = uf_invalid_file_format(FileName),
Pieces = [words("invalid version number in"), quote(FileName),
suffix("."), nl],
Spec = simplest_no_context_spec($pred, severity_informational,
phase_read_files, PrefixPieces ++ Pieces)
;
UsedFileError = uf_syntax_error(Context, Message),
AllPieces = PrefixPieces ++ [words(Message), suffix("."), nl],
Spec = simplest_spec($pred, severity_informational, phase_read_files,
Context, AllPieces)
;
UsedFileError = uf_unreadable_used_items(UsedItemSpecs),
list.map(extract_spec_msgs(Globals), UsedItemSpecs, MsgsList),
list.condense(MsgsList, Msgs),
% MaybeContext = find_first_context_in_msgs(Msgs),
Spec = error_spec($pred, severity_informational, phase_read_files,
Msgs)
),
write_error_spec(Stream, Globals, Spec, !IO).
:- pred should_recompile_3(globals::in, used_file::in,
maybe_is_inline_submodule::in,
find_target_file_names::in(find_target_file_names),
maybe(recompile_reason)::out,
recompilation_check_info::in, recompilation_check_info::out,
io::di, io::uo) is det.
should_recompile_3(Globals, UsedFile, IsSubModule, FindTargetFiles,
MaybeStoppingReason, !Info, !IO) :-
% WARNING: any exceptions thrown before the sub_modules field is set
% in the recompilation_check_info must set the modules_to_recompile field
% to `all', or else the nested submodules will not be checked
% and necessary recompilations may be missed.
UsedFile = used_file(ModuleTimestamp, InlineSubModules,
UsedItems, UsedClasses, UsedModules),
ModuleTimestamp = module_timestamp(_, RecordedTimestamp, _),
!Info ^ rci_sub_modules := InlineSubModules,
!Info ^ rci_used_items := UsedItems,
!Info ^ rci_used_typeclasses := set.list_to_set(UsedClasses),
(
IsSubModule = is_inline_submodule,
% For inline submodules, we don't need to check the module
% timestamp, because we have already checked the timestamp
% for the parent module.
MaybeStoppingReason0 = no
;
IsSubModule = is_not_inline_submodule,
% If the module has changed, recompile.
MaybeProgressStream = maybe.no,
ModuleName = !.Info ^ rci_module_name,
read_module_src(MaybeProgressStream, Globals, rrm_std(ModuleName),
do_not_ignore_errors, do_search, ModuleName, [],
dont_read_module_if_match(RecordedTimestamp), HaveReadSrc, !IO),
(
HaveReadSrc = have_not_read_module(FileName, Errors),
% If we did not read the source file because its timestamp
% matched RecordedTimestamp, then there will be no errors.
( if there_are_some_errors(Errors) then
MaybeStoppingReason0 =
yes(read_module_error_stopping_reason(FileName, Errors))
else
MaybeStoppingReason0 = no
)
;
HaveReadSrc = have_read_module(FileName, MaybeNewTimestamp,
ParseTreeSrc, Errors),
( if
MaybeNewTimestamp = yes(NewTimestamp),
NewTimestamp \= RecordedTimestamp
then
record_read_file_src(ModuleName, FileName,
ModuleTimestamp ^ mts_timestamp := NewTimestamp,
ParseTreeSrc, Errors, !Info),
!Info ^ rci_modules_to_recompile := all_modules,
ChangedReason = recompile_for_module_changed(FileName),
record_recompilation_reason(ChangedReason,
MaybeStoppingReason0, !Info)
else if
( there_are_some_errors(Errors)
; MaybeNewTimestamp = no
)
then
MaybeStoppingReason0 =
yes(read_module_error_stopping_reason(FileName, Errors))
else
% We are throwing away ModuleErrors. Since it should be
% a repeat of the errors we saw when the file was first
% read in, this should be OK.
MaybeStoppingReason0 = no
)
)
),
(
MaybeStoppingReason0 = yes(_),
MaybeStoppingReason = MaybeStoppingReason0
;
MaybeStoppingReason0 = no,
% Check whether the output files are present and up-to-date.
FindTargetFiles(!.Info ^ rci_module_name, TargetFiles, !IO),
list.foldl3(
require_recompilation_if_not_up_to_date(RecordedTimestamp),
TargetFiles,
MaybeStoppingReason0, MaybeStoppingReason1, !Info, !IO),
check_imported_modules(Globals, UsedModules,
MaybeStoppingReason1, MaybeStoppingReason, !Info, !IO)
).
:- func read_module_error_stopping_reason(file_name, read_module_errors)
= recompile_reason.
read_module_error_stopping_reason(FileName, _Errors) = FileReason :-
% We are throwing away the error_specs in _Errors, even though they
% could illuminate the cause of the problem. XXX Why is this OK?
Pieces = [words("error reading file"), quote(FileName), suffix("."), nl],
% XXX Some of the errors in Errors could be errors other than
% syntax errors.
FileReason = recompile_for_file_error(FileName, Pieces).
:- pred require_recompilation_if_not_up_to_date(timestamp::in, file_name::in,
maybe(recompile_reason)::in, maybe(recompile_reason)::out,
recompilation_check_info::in, recompilation_check_info::out,
io::di, io::uo) is det.
require_recompilation_if_not_up_to_date(RecordedTimestamp, TargetFile,
!MaybeStoppingReason, !Info, !IO) :-
(
!.MaybeStoppingReason = yes(_)
;
!.MaybeStoppingReason = no,
io.file.file_modification_time(TargetFile, TargetModTimeResult, !IO),
( if
TargetModTimeResult = ok(TargetModTime),
compare(TargetModTimeCompare, time_t_to_timestamp(TargetModTime),
RecordedTimestamp),
TargetModTimeCompare = (>)
then
!:MaybeStoppingReason = no
else
Reason = recompile_for_output_file_not_up_to_date(TargetFile),
record_recompilation_reason(Reason, !:MaybeStoppingReason, !Info)
)
).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- pred check_imported_modules(globals::in, list(recomp_used_module)::in,
maybe(recompile_reason)::in, maybe(recompile_reason)::out,
recompilation_check_info::in, recompilation_check_info::out,
io::di, io::uo) is det.
check_imported_modules(_Globals, [], !MaybeStoppingReason, !Info, !IO).
check_imported_modules(Globals, [HeadUsedModule | TailUsedModules],
!MaybeStoppingReason, !Info, !IO) :-
(
!.MaybeStoppingReason = yes(_)
;
!.MaybeStoppingReason = no,
check_imported_module(Globals, HeadUsedModule,
!:MaybeStoppingReason, !Info, !IO),
check_imported_modules(Globals, TailUsedModules,
!MaybeStoppingReason, !Info, !IO)
).
%---------------------------------------------------------------------------%
:- typeclass check_imported_module_int_file(PT) where [
pred cim_search_mapN(have_read_module_map(PT)::in,
module_name::in, have_read_module(PT)::out) is semidet,
pred cim_read_module_intN(globals::in, read_reason_msg::in,
maybe_ignore_errors::in, maybe_search::in, module_name::in,
read_module_and_timestamps::in, have_read_module(PT)::out,
io::di, io::uo) is det,
pred cim_record_read_file_intN(module_name::in, file_name::in,
module_timestamp::in, PT::in, read_module_errors::in,
recompilation_check_info::in, recompilation_check_info::out) is det,
pred cim_get_version_numbersN(PT::in,
module_item_version_numbers::out) is semidet,
pred cim_get_ambiguity_checkablesN(PT::in,
ambiguity_checkables::out) is det
].
:- instance check_imported_module_int_file(parse_tree_int0) where [
( cim_search_mapN(HRMM, ModuleName, HaveReadModule) :-
map.search(HRMM, ModuleName, HaveReadModule)
),
pred(cim_read_module_intN/9) is read_module_int0_no_stream,
pred(cim_record_read_file_intN/7) is record_read_file_int0,
( cim_get_version_numbersN(PT, VN) :-
PT ^ pti0_maybe_version_numbers = version_numbers(VN)
),
pred(cim_get_ambiguity_checkablesN/2) is get_ambiguity_checkables_int0
].
:- instance check_imported_module_int_file(parse_tree_int1) where [
( cim_search_mapN(HRMM, ModuleName, HaveReadModule) :-
map.search(HRMM, ModuleName, HaveReadModule)
),
pred(cim_read_module_intN/9) is read_module_int1_no_stream,
pred(cim_record_read_file_intN/7) is record_read_file_int1,
( cim_get_version_numbersN(PT, VN) :-
PT ^ pti1_maybe_version_numbers = version_numbers(VN)
),
pred(cim_get_ambiguity_checkablesN/2) is get_ambiguity_checkables_int1
].
:- instance check_imported_module_int_file(parse_tree_int2) where [
( cim_search_mapN(HRMM, ModuleName, HaveReadModule) :-
map.search(HRMM, ModuleName, HaveReadModule)
),
pred(cim_read_module_intN/9) is read_module_int2_no_stream,
pred(cim_record_read_file_intN/7) is record_read_file_int2,
( cim_get_version_numbersN(PT, VN) :-
PT ^ pti2_maybe_version_numbers = version_numbers(VN)
),
pred(cim_get_ambiguity_checkablesN/2) is get_ambiguity_checkables_int2
].
:- instance check_imported_module_int_file(parse_tree_int3) where [
( cim_search_mapN(HRMM, ModuleName, HaveReadModule) :-
map.search(HRMM, ModuleName, HaveReadModule)
),
pred(cim_read_module_intN/9) is read_module_int3_no_stream,
pred(cim_record_read_file_intN/7) is record_read_file_int3,
( cim_get_version_numbersN(_PT, _VN) :-
fail
),
pred(cim_get_ambiguity_checkablesN/2) is get_ambiguity_checkables_int3
].
%---------------------------------------------------------------------------%
% Check whether the interface file read for a module in the last
% compilation has changed, and if so whether the items have changed
% in a way which should cause a recompilation.
%
:- pred check_imported_module(globals::in, recomp_used_module::in,
maybe(recompile_reason)::out,
recompilation_check_info::in, recompilation_check_info::out,
io::di, io::uo) is det.
check_imported_module(Globals, UsedModule, MaybeStoppingReason, !Info, !IO) :-
UsedModule = recomp_used_module(ImportedModuleName, ModuleTimestamp,
MaybeUsedVersionNumbers),
ModuleTimestamp =
module_timestamp(FileKind, _RecordedTimestamp, _RecompAvail),
(
FileKind = fk_int(IntFileKind)
;
FileKind = fk_src,
unexpected($pred, "fk_src")
;
FileKind = fk_opt(_),
unexpected($pred, "fk_opt")
),
HaveReadModuleMaps = !.Info ^ rci_have_read_module_maps,
(
IntFileKind = ifk_int0,
check_imported_module_intN(Globals, ImportedModuleName,
ModuleTimestamp, MaybeUsedVersionNumbers,
HaveReadModuleMaps ^ hrmm_int0, MaybeStoppingReason, !Info, !IO)
;
IntFileKind = ifk_int1,
check_imported_module_intN(Globals, ImportedModuleName,
ModuleTimestamp, MaybeUsedVersionNumbers,
HaveReadModuleMaps ^ hrmm_int1, MaybeStoppingReason, !Info, !IO)
;
IntFileKind = ifk_int2,
check_imported_module_intN(Globals, ImportedModuleName,
ModuleTimestamp, MaybeUsedVersionNumbers,
HaveReadModuleMaps ^ hrmm_int2, MaybeStoppingReason, !Info, !IO)
;
IntFileKind = ifk_int3,
check_imported_module_intN(Globals, ImportedModuleName,
ModuleTimestamp, MaybeUsedVersionNumbers,
HaveReadModuleMaps ^ hrmm_int3, MaybeStoppingReason, !Info, !IO)
).
:- pred check_imported_module_intN(globals::in, module_name::in,
module_timestamp::in, maybe(module_item_version_numbers)::in,
have_read_module_map(PT)::in, maybe(recompile_reason)::out,
recompilation_check_info::in, recompilation_check_info::out,
io::di, io::uo) is det <= check_imported_module_int_file(PT).
check_imported_module_intN(Globals, ImportedModuleName, ModuleTimestamp,
MaybeUsedVersionNumbers, HRMM, MaybeStoppingReason, !Info, !IO) :-
ModuleTimestamp =
module_timestamp(_FileKind, RecordedTimestamp, _RecompAvail),
( if
% If we are checking a nested submodule, don't re-read interface files
% read for other modules checked during this compilation.
% XXX We restrict this optimization to nested submodules?
!.Info ^ rci_is_inline_sub_module = yes,
cim_search_mapN(HRMM, ImportedModuleName, HaveReadModuleIntNPrime)
then
Recorded = bool.yes,
HaveReadModuleIntN = HaveReadModuleIntNPrime
else
Recorded = bool.no,
cim_read_module_intN(Globals, rrm_std(ImportedModuleName),
do_not_ignore_errors, do_search, ImportedModuleName,
dont_read_module_if_match(RecordedTimestamp),
HaveReadModuleIntN, !IO)
),
(
HaveReadModuleIntN = have_not_read_module(FileName, Errors),
% If we did not read the interface file because its timestamp
% matched RecordedTimestamp, then there will be no errors.
( if there_are_some_errors(Errors) then
MaybeStoppingReason =
yes(read_module_error_stopping_reason(FileName, Errors))
else
MaybeStoppingReason = no
)
;
HaveReadModuleIntN = have_read_module(FileName, MaybeNewTimestamp,
ParseTreeIntN, Errors),
( if there_are_some_errors(Errors) then
% We are throwing away Specs, even though some of its elements
% could illuminate the cause of the problem. XXX Is this OK?
MaybeStoppingReason =
yes(read_module_error_stopping_reason(FileName, Errors))
else if
MaybeNewTimestamp = yes(NewTimestamp),
NewTimestamp \= RecordedTimestamp
then
(
Recorded = no,
cim_record_read_file_intN(ImportedModuleName, FileName,
ModuleTimestamp ^ mts_timestamp := NewTimestamp,
ParseTreeIntN, Errors, !Info)
;
Recorded = yes
),
( if
MaybeUsedVersionNumbers = yes(UsedVersionNumbers),
cim_get_version_numbersN(ParseTreeIntN, VersionNumbers)
then
cim_get_ambiguity_checkablesN(ParseTreeIntN, Checkables),
check_module_used_items(ImportedModuleName,
ModuleTimestamp, UsedVersionNumbers, VersionNumbers,
Checkables, MaybeStoppingReason, !Info)
else
Reason = recompile_for_module_changed(FileName),
record_recompilation_reason(Reason, MaybeStoppingReason,
!Info)
)
else
% We are throwing away the error_specs in Errors. Since it
% should be a repeat of the errors we saw when the file
% was first read in, this should be OK.
MaybeStoppingReason = no
)
).
%---------------------------------------------------------------------------%
:- pred check_module_used_items(module_name::in, module_timestamp::in,
module_item_version_numbers::in, module_item_version_numbers::in,
ambiguity_checkables::in, maybe(recompile_reason)::out,
recompilation_check_info::in, recompilation_check_info::out) is det.
check_module_used_items(ModuleName, OldModuleTimestamp,
UsedVersionNumbers, NewVersionNumbers, ParseTreeCheckables,
!:MaybeStoppingReason, !Info) :-
OldModuleTimestamp = module_timestamp(_FK, OldTimestamp, RecompAvail),
UsedVersionNumbers =
module_item_version_numbers(UsedTypeNameMap, UsedTypeDefnMap,
UsedInstMap, UsedModeMap, UsedClassMap, UsedInstanceMap,
UsedPredMap, UsedFuncMap),
NewVersionNumbers =
module_item_version_numbers(NewTypeNameMap, NewTypeDefnMap,
NewInstMap, NewModeMap, NewClassMap, NewInstanceMap,
NewPredMap, NewFuncMap),
!:MaybeStoppingReason = no,
% Check whether any of the items which were used have changed.
check_name_arity_version_numbers(ModuleName, recomp_type_name,
UsedTypeNameMap, NewTypeNameMap, !MaybeStoppingReason, !Info),
check_name_arity_version_numbers(ModuleName, recomp_type_defn,
UsedTypeDefnMap, NewTypeDefnMap, !MaybeStoppingReason, !Info),
check_name_arity_version_numbers(ModuleName, recomp_inst,
UsedInstMap, NewInstMap, !MaybeStoppingReason, !Info),
check_name_arity_version_numbers(ModuleName, recomp_mode,
UsedModeMap, NewModeMap, !MaybeStoppingReason, !Info),
check_name_arity_version_numbers(ModuleName, recomp_typeclass,
UsedClassMap, NewClassMap, !MaybeStoppingReason, !Info),
check_item_name_version_numbers(ModuleName,
UsedInstanceMap, NewInstanceMap, !MaybeStoppingReason, !Info),
check_name_arity_version_numbers(ModuleName, recomp_predicate,
UsedPredMap, NewPredMap, !MaybeStoppingReason, !Info),
check_name_arity_version_numbers(ModuleName, recomp_function,
UsedFuncMap, NewFuncMap, !MaybeStoppingReason, !Info),
% Check whether added or modified items could cause name resolution
% ambiguities with items which were used.
ParseTreeCheckables = ambiguity_checkables(ItemTypeDefns,
ItemInstDefns, ItemModeDefns, ItemTypeClasses, ItemPredDecls),
check_items_for_ambiguities(
check_type_defn_info_for_ambiguities(RecompAvail, OldTimestamp,
UsedVersionNumbers),
ItemTypeDefns, !MaybeStoppingReason, !Info),
check_items_for_ambiguities(
check_inst_defn_info_for_ambiguities(RecompAvail, OldTimestamp,
UsedVersionNumbers),
ItemInstDefns, !MaybeStoppingReason, !Info),
check_items_for_ambiguities(
check_mode_defn_info_for_ambiguities(RecompAvail, OldTimestamp,
UsedVersionNumbers),
ItemModeDefns, !MaybeStoppingReason, !Info),
check_items_for_ambiguities(
check_typeclass_info_for_ambiguities(RecompAvail, OldTimestamp,
UsedVersionNumbers),
ItemTypeClasses, !MaybeStoppingReason, !Info),
check_items_for_ambiguities(
check_pred_decl_info_for_ambiguities(RecompAvail, OldTimestamp,
UsedVersionNumbers),
ItemPredDecls, !MaybeStoppingReason, !Info),
(
!.MaybeStoppingReason = yes(_)
;
!.MaybeStoppingReason = no,
% Check for new instances for used typeclasses.
ModuleInstances = map.keys_as_set(NewInstanceMap),
UsedInstances = map.keys_as_set(UsedInstanceMap),
UsedClasses = !.Info ^ rci_used_typeclasses,
set.difference(set.intersect(UsedClasses, ModuleInstances),
UsedInstances, AddedInstances),
AddedInstancesList = set.to_sorted_list(AddedInstances),
(
AddedInstancesList = [],
!:MaybeStoppingReason = no
;
AddedInstancesList = [FirstAddedInstance | _],
Reason1 = recompile_for_changed_or_added_instance(ModuleName,
FirstAddedInstance),
record_recompilation_reason(Reason1, !:MaybeStoppingReason, !Info)
)
).
:- func make_item_id(module_name, recomp_item_type, name_arity)
= recomp_item_id.
make_item_id(Module, ItemType, name_arity(Name, Arity)) =
recomp_item_id(ItemType, recomp_item_name(qualified(Module, Name), Arity)).
%---------------------------------------------------------------------------%
:- pred check_name_arity_version_numbers(module_name::in, recomp_item_type::in,
name_arity_version_map::in, name_arity_version_map::in,
maybe(recompile_reason)::in, maybe(recompile_reason)::out,
recompilation_check_info::in, recompilation_check_info::out) is det.
check_name_arity_version_numbers(ModuleName, ItemType,
UsedVersionMap, NewVersionMap, !MaybeStoppingReason, !Info) :-
(
!.MaybeStoppingReason = yes(_)
;
!.MaybeStoppingReason = no,
map.foldl2(
check_name_arity_version_number(ModuleName, ItemType,
NewVersionMap),
UsedVersionMap, !MaybeStoppingReason, !Info)
).
:- pred check_name_arity_version_number(module_name::in, recomp_item_type::in,
name_arity_version_map::in, name_arity::in, version_number::in,
maybe(recompile_reason)::in, maybe(recompile_reason)::out,
recompilation_check_info::in, recompilation_check_info::out) is det.
check_name_arity_version_number(ModuleName, ItemType, NewVersionMap,
NameArity, UsedVersionNumber, !MaybeStoppingReason, !Info) :-
(
!.MaybeStoppingReason = yes(_)
;
!.MaybeStoppingReason = no,
( if map.search(NewVersionMap, NameArity, NewVersionNumber) then
( if NewVersionNumber = UsedVersionNumber then
true
else
ItemId = make_item_id(ModuleName, ItemType, NameArity),
Reason = recompile_for_changed_item(ItemId),
record_recompilation_reason(Reason, !:MaybeStoppingReason,
!Info)
)
else
ItemId = make_item_id(ModuleName, ItemType, NameArity),
Reason = recompile_for_removed_item(ItemId),
record_recompilation_reason(Reason, !:MaybeStoppingReason, !Info)
)
).
:- pred check_item_name_version_numbers(module_name::in,
recomp_item_name_version_map::in, recomp_item_name_version_map::in,
maybe(recompile_reason)::in, maybe(recompile_reason)::out,
recompilation_check_info::in, recompilation_check_info::out) is det.
check_item_name_version_numbers(ModuleName, UsedVersionMap, NewVersionMap,
!MaybeStoppingReason, !Info) :-
map.foldl2(
check_item_name_version_number(ModuleName, NewVersionMap),
UsedVersionMap, !MaybeStoppingReason, !Info).
:- pred check_item_name_version_number(module_name::in,
recomp_item_name_version_map::in, recomp_item_name::in, version_number::in,
maybe(recompile_reason)::in, maybe(recompile_reason)::out,
recompilation_check_info::in, recompilation_check_info::out) is det.
check_item_name_version_number(ModuleName, NewVersionMap,
ItemName, UsedVersionNumber, !MaybeStoppingReason, !Info) :-
(
!.MaybeStoppingReason = yes(_)
;
!.MaybeStoppingReason = no,
( if map.search(NewVersionMap, ItemName, NewVersionNumber) then
( if UsedVersionNumber = NewVersionNumber then
true
else
% XXX RECOMP In the same circumstance, the name_arity version
% of this predicate above returns recompile_for_changed_item,
% with no "_or_added".
Reason = recompile_for_changed_or_added_instance(ModuleName,
ItemName),
record_recompilation_reason(Reason, !:MaybeStoppingReason,
!Info)
)
else
Reason = recompile_for_removed_instance(ModuleName, ItemName),
record_recompilation_reason(Reason, !:MaybeStoppingReason, !Info)
)
).
%---------------------------------------------------------------------------%
:- pred check_items_for_ambiguities(
pred(T, maybe(recompile_reason), maybe(recompile_reason),
recompilation_check_info, recompilation_check_info)
::in(pred(in, in, out, in, out) is det),
list(T)::in,
maybe(recompile_reason)::in, maybe(recompile_reason)::out,
recompilation_check_info::in, recompilation_check_info::out) is det.
check_items_for_ambiguities(_CheckPred, [], !MaybeStoppingReason, !Info).
check_items_for_ambiguities(CheckPred, [HeadItem | TailItems],
!MaybeStoppingReason, !Info) :-
(
!.MaybeStoppingReason = yes(_)
;
!.MaybeStoppingReason = no,
CheckPred(HeadItem, no, !:MaybeStoppingReason, !Info),
check_items_for_ambiguities(CheckPred, TailItems,
!MaybeStoppingReason, !Info)
).
%---------------------%
:- pred check_type_defn_info_for_ambiguities(recomp_avail::in, timestamp::in,
module_item_version_numbers::in, item_type_defn_info::in,
maybe(recompile_reason)::in, maybe(recompile_reason)::out,
recompilation_check_info::in, recompilation_check_info::out) is det.
check_type_defn_info_for_ambiguities(RecompAvail, OldTimestamp, VersionNumbers,
ItemTypeDefn, !MaybeStoppingReason, !Info) :-
ItemTypeDefn = item_type_defn_info(TypeSymName, TypeParams, TypeBody,
_, _, _),
list.length(TypeParams, TypeArity),
check_for_simple_item_ambiguity(RecompAvail, OldTimestamp,
VersionNumbers ^ mivn_type_names, recomp_type_name,
TypeSymName, TypeArity, NeedsCheck, !MaybeStoppingReason, !Info),
(
NeedsCheck = yes,
TypeCtor = type_ctor(TypeSymName, TypeArity),
check_type_defn_ambiguity_with_functor(RecompAvail,
TypeCtor, TypeBody, !MaybeStoppingReason, !Info)
;
NeedsCheck = no
).
%---------------------%
:- pred check_inst_defn_info_for_ambiguities(recomp_avail::in, timestamp::in,
module_item_version_numbers::in, item_inst_defn_info::in,
maybe(recompile_reason)::in, maybe(recompile_reason)::out,
recompilation_check_info::in, recompilation_check_info::out) is det.
check_inst_defn_info_for_ambiguities(RecompAvail, OldTimestamp, VersionNumbers,
ItemInstDefn, !MaybeStoppingReason, !Info) :-
% XXX IFTC Do we need to check _MaybeForTypeCtor?
ItemInstDefn = item_inst_defn_info(InstSymName, InstParams,
_MaybeForTypeCtor, _, _, _, _),
list.length(InstParams, InstArity),
check_for_simple_item_ambiguity(RecompAvail, OldTimestamp,
VersionNumbers ^ mivn_insts, recomp_inst, InstSymName, InstArity,
_NeedsCheck, !MaybeStoppingReason, !Info).
%---------------------%
:- pred check_mode_defn_info_for_ambiguities(recomp_avail::in, timestamp::in,
module_item_version_numbers::in, item_mode_defn_info::in,
maybe(recompile_reason)::in, maybe(recompile_reason)::out,
recompilation_check_info::in, recompilation_check_info::out) is det.
check_mode_defn_info_for_ambiguities(RecompAvail, OldTimestamp, VersionNumbers,
ItemModeDefn, !MaybeStoppingReason, !Info) :-
ItemModeDefn = item_mode_defn_info(ModeSymName, ModeParams, _, _, _, _),
list.length(ModeParams, ModeArity),
check_for_simple_item_ambiguity(RecompAvail, OldTimestamp,
VersionNumbers ^ mivn_modes, recomp_mode, ModeSymName, ModeArity,
_NeedsCheck, !MaybeStoppingReason, !Info).
%---------------------%
:- pred check_typeclass_info_for_ambiguities(recomp_avail::in,
timestamp::in, module_item_version_numbers::in, item_typeclass_info::in,
maybe(recompile_reason)::in, maybe(recompile_reason)::out,
recompilation_check_info::in, recompilation_check_info::out) is det.
check_typeclass_info_for_ambiguities(RecompAvail, OldTimestamp, VersionNumbers,
ItemTypeClass, !MaybeStoppingReason, !Info) :-
ItemTypeClass = item_typeclass_info(TypeClassSymName, TypeClassParams,
_, _, Interface, _, _, _),
list.length(TypeClassParams, TypeClassArity),
check_for_simple_item_ambiguity(RecompAvail, OldTimestamp,
VersionNumbers ^ mivn_typeclasses, recomp_typeclass,
TypeClassSymName, TypeClassArity,
NeedsCheck, !MaybeStoppingReason, !Info),
( if
NeedsCheck = yes,
Interface = class_interface_concrete(ClassDecls)
then
list.foldl2(
check_class_decl_for_ambiguities(RecompAvail, OldTimestamp,
VersionNumbers),
ClassDecls, !MaybeStoppingReason, !Info)
else
true
).
:- pred check_class_decl_for_ambiguities(recomp_avail::in,
timestamp::in, module_item_version_numbers::in, class_decl::in,
maybe(recompile_reason)::in, maybe(recompile_reason)::out,
recompilation_check_info::in, recompilation_check_info::out) is det.
check_class_decl_for_ambiguities(RecompAvail, OldTimestamp, VersionNumbers,
Decl, !MaybeStoppingReason, !Info) :-
(
Decl = class_decl_pred_or_func(PredOrFuncInfo),
PredOrFuncInfo = class_pred_or_func_info(MethodName, PredOrFunc,
MethodArgs, MethodWithType, _, _, _, _, _, _, _, _),
check_for_pred_or_func_item_ambiguity(yes, RecompAvail,
OldTimestamp, VersionNumbers, PredOrFunc, MethodName,
MethodArgs, MethodWithType, !MaybeStoppingReason, !Info)
;
Decl = class_decl_mode(_)
).
%---------------------%
:- pred check_pred_decl_info_for_ambiguities(recomp_avail::in,
timestamp::in, module_item_version_numbers::in, item_pred_decl_info::in,
maybe(recompile_reason)::in, maybe(recompile_reason)::out,
recompilation_check_info::in, recompilation_check_info::out) is det.
check_pred_decl_info_for_ambiguities(RecompAvail, OldTimestamp,
VersionNumbers, ItemPredDecl, !MaybeStoppingReason, !Info) :-
ItemPredDecl = item_pred_decl_info(PredSymName, PredOrFunc, Args,
WithType, _, _, _, _, _, _, _, _, _, _),
check_for_pred_or_func_item_ambiguity(no, RecompAvail, OldTimestamp,
VersionNumbers, PredOrFunc, PredSymName, Args, WithType,
!MaybeStoppingReason, !Info).
%---------------------------------------------------------------------------%
:- pred check_for_simple_item_ambiguity(recomp_avail::in, timestamp::in,
name_arity_version_map::in, recomp_item_type::in(recomp_simple),
sym_name::in, arity::in, bool::out,
maybe(recompile_reason)::in, maybe(recompile_reason)::out,
recompilation_check_info::in, recompilation_check_info::out) is det.
check_for_simple_item_ambiguity(RecompAvail, UsedFileTimestamp,
VersionMap, ItemType, SymName, Arity, NeedsCheck,
!MaybeStoppingReason, !Info) :-
(
!.MaybeStoppingReason = yes(_),
% Since we have found a reason to recompile, we don't need to look
% for more reasons.
NeedsCheck = no
;
!.MaybeStoppingReason = no,
( if
item_is_new_or_changed(UsedFileTimestamp, VersionMap,
SymName, Arity)
then
NeedsCheck = yes,
UsedItems = !.Info ^ rci_used_items,
(
ItemType = recomp_type_name,
UsedItemMap = UsedItems ^ rui_type_names
;
ItemType = recomp_type_defn,
unexpected($pred, "type_body_item")
;
ItemType = recomp_inst,
UsedItemMap = UsedItems ^ rui_insts
;
ItemType = recomp_mode,
UsedItemMap = UsedItems ^ rui_modes
;
ItemType = recomp_typeclass,
UsedItemMap = UsedItems ^ rui_typeclasses
),
NameArity = name_arity(unqualify_name(SymName), Arity),
( if map.search(UsedItemMap, NameArity, MatchingQualifiers) then
map.foldl2(
check_for_simple_item_ambiguity_2(ItemType,
RecompAvail, SymName, Arity),
MatchingQualifiers, !MaybeStoppingReason, !Info)
else
true
)
else
NeedsCheck = no
)
).
:- pred check_for_simple_item_ambiguity_2(recomp_item_type::in,
recomp_avail::in, sym_name::in, arity::in,
module_qualifier::in, module_name::in,
maybe(recompile_reason)::in, maybe(recompile_reason)::out,
recompilation_check_info::in, recompilation_check_info::out) is det.
check_for_simple_item_ambiguity_2(ItemType, RecompAvail, SymName, Arity,
OldModuleQualifier, OldMatchingModuleName,
!MaybeStoppingReason, !Info) :-
(
!.MaybeStoppingReason = yes(_)
;
!.MaybeStoppingReason = no,
Name = unqualify_name(SymName),
( if
% XXX RECOMP401 This logic is ancient, and may do the wrong thing
% with most values of RecompAvail, since those values did not exist
% when the original version of this code was written.
( RecompAvail = recomp_avail_int_use
; RecompAvail = recomp_avail_imp_use
),
% XXX This is a bit conservative in the case of partially qualified
% names but that hopefully won't come up too often.
OldModuleQualifier = unqualified("")
then
true
else if
QualifiedName = module_qualify_name(OldModuleQualifier, Name),
partial_sym_name_matches_full(QualifiedName, SymName),
not SymName = qualified(OldMatchingModuleName, _)
then
OldMatchingSymName = qualified(OldMatchingModuleName, Name),
ItemName = recomp_item_name(SymName, Arity),
OldItemName = recomp_item_name(OldMatchingSymName, Arity),
Reason = recompile_for_item_ambiguity(
recomp_item_id(ItemType, ItemName),
[recomp_item_id(ItemType, OldItemName)]),
record_recompilation_reason(Reason, !:MaybeStoppingReason, !Info)
else
true
)
).
:- pred item_is_new_or_changed(timestamp::in, name_arity_version_map::in,
sym_name::in, arity::in) is semidet.
item_is_new_or_changed(UsedFileTimestamp, UsedVersionMap, SymName, Arity) :-
NameArity = name_arity(unqualify_name(SymName), Arity),
( if map.search(UsedVersionMap, NameArity, UsedVersionNumber) then
% XXX This assumes that version numbers are timestamps.
compare((>), UsedVersionNumber, UsedFileTimestamp)
else
true
).
:- pred check_for_pred_or_func_item_ambiguity(bool::in,
recomp_avail::in, timestamp::in, module_item_version_numbers::in,
pred_or_func::in, sym_name::in,
list(type_and_mode)::in, maybe(mer_type)::in,
maybe(recompile_reason)::in, maybe(recompile_reason)::out,
recompilation_check_info::in, recompilation_check_info::out) is det.
check_for_pred_or_func_item_ambiguity(NeedsCheck, RecompAvail, OldTimestamp,
VersionNumbers, PredOrFunc, SymName, Args, WithType,
!MaybeStoppingReason, !Info) :-
(
!.MaybeStoppingReason = yes(_)
;
!.MaybeStoppingReason = no,
list.length(Args, PredFormArityInt),
(
WithType = no,
% XXX Given that we use pred_form_arity elsewhere
% when we process resolved_functor_pred_or_func,
% setting Arity here to the user_arity looks to be a bug.
% Unfortunately, ...
adjust_func_arity(PredOrFunc, UserArityInt, PredFormArityInt)
;
WithType = yes(_),
% ... in the presence of with_type, we have no idea what even
% the actual pred_form_arity is.
UserArityInt = PredFormArityInt
),
( if
(
NeedsCheck = yes
;
(
PredOrFunc = pf_predicate,
PredMap = VersionNumbers ^ mivn_predicates,
item_is_new_or_changed(OldTimestamp, PredMap,
SymName, UserArityInt)
;
PredOrFunc = pf_function,
FuncMap = VersionNumbers ^ mivn_functions,
item_is_new_or_changed(OldTimestamp, FuncMap,
SymName, UserArityInt)
)
)
then
UsedItems = !.Info ^ rci_used_items,
(
PredOrFunc = pf_predicate,
ItemType = recomp_predicate,
UsedItemMap = UsedItems ^ rui_predicates
;
PredOrFunc = pf_function,
ItemType = recomp_function,
UsedItemMap = UsedItems ^ rui_functions
),
Name = unqualify_name(SymName),
( if map.search(UsedItemMap, Name, MatchingArityList) then
list.foldl2(
check_for_pred_or_func_item_ambiguity_1(WithType,
ItemType, RecompAvail, SymName, UserArityInt),
MatchingArityList, no, !:MaybeStoppingReason, !Info)
else
!:MaybeStoppingReason = no
),
InvPredId = invalid_pred_id,
(
SymName = qualified(ModuleName, _),
(
WithType = yes(_),
% We don't know the actual arity.
AritiesToMatch = match_arity_any
;
WithType = no,
AritiesToMatch =
match_arity_less_than_or_equal(UserArityInt)
),
ResolvedFunctor = resolved_functor_pred_or_func(InvPredId,
PredOrFunc, ModuleName, pred_form_arity(PredFormArityInt)),
check_functor_ambiguities_by_name(RecompAvail, SymName,
AritiesToMatch, ResolvedFunctor,
!MaybeStoppingReason, !Info)
;
SymName = unqualified(_),
unexpected($pred, "unqualified predicate name")
)
else
!:MaybeStoppingReason = no
)
).
:- pred check_for_pred_or_func_item_ambiguity_1(maybe(mer_type)::in,
recomp_item_type::in, recomp_avail::in, sym_name::in, arity::in,
pair(arity, map(sym_name, set(pair(pred_id, module_name))))::in,
maybe(recompile_reason)::in, maybe(recompile_reason)::out,
recompilation_check_info::in, recompilation_check_info::out) is det.
check_for_pred_or_func_item_ambiguity_1(WithType, ItemType, RecompAvail,
SymName, Arity, MatchArity - MatchingQualifiers,
!MaybeStoppingReason, !Info) :-
( if
(
WithType = yes(_),
MatchArity >= Arity
;
WithType = no,
MatchArity = Arity
)
then
map.foldl2(
check_for_pred_or_func_item_ambiguity_2(ItemType, RecompAvail,
SymName, MatchArity),
MatchingQualifiers, !MaybeStoppingReason, !Info)
else
true
).
:- pred check_for_pred_or_func_item_ambiguity_2(recomp_item_type::in,
recomp_avail::in, sym_name::in, arity::in, module_qualifier::in,
set(pair(pred_id, module_name))::in,
maybe(recompile_reason)::in, maybe(recompile_reason)::out,
recompilation_check_info::in, recompilation_check_info::out) is det.
check_for_pred_or_func_item_ambiguity_2(ItemType, RecompAvail,
SymName, Arity, OldModuleQualifier, OldMatchingModuleNames,
!MaybeStoppingReason, !Info) :-
(
!.MaybeStoppingReason = yes(_)
;
!.MaybeStoppingReason = no,
Name = unqualify_name(SymName),
( if
% XXX RECOMP401 This logic is ancient, and may do the wrong thing
% with most values of RecompAvail, since those values did not exist
% when the original version of this was written.
( RecompAvail = recomp_avail_int_use
; RecompAvail = recomp_avail_imp_use
),
% XXX This is a bit conservative in the case of partially qualified
% names but that hopefully won't come up too often.
OldModuleQualifier = unqualified("")
then
!:MaybeStoppingReason = no
else if
QualifiedName = module_qualify_name(OldModuleQualifier, Name),
partial_sym_name_matches_full(QualifiedName, SymName),
not (
SymName = qualified(PredModuleName, _),
set.member(_ - PredModuleName, OldMatchingModuleNames)
)
then
AmbiguousDecls = list.map(
( func(_ - OldMatchingModule) = Item :-
OldMatchingName = qualified(OldMatchingModule, Name),
Item = recomp_item_id(ItemType,
recomp_item_name(OldMatchingName, Arity))
),
set.to_sorted_list(OldMatchingModuleNames)),
Reason = recompile_for_item_ambiguity(recomp_item_id(ItemType,
recomp_item_name(SymName, Arity)), AmbiguousDecls),
record_recompilation_reason(Reason, !:MaybeStoppingReason, !Info)
else
!:MaybeStoppingReason = no
)
).
% Go over the constructors for a type which has changed and check whether
% any of them could create an ambiguity with functors used during the
% last compilation.
%
:- pred check_type_defn_ambiguity_with_functor(recomp_avail::in,
type_ctor::in, type_defn::in,
maybe(recompile_reason)::in, maybe(recompile_reason)::out,
recompilation_check_info::in, recompilation_check_info::out) is det.
check_type_defn_ambiguity_with_functor(RecompAvail, TypeCtor, TypeDefn,
!MaybeStoppingReason, !Info) :-
(
( TypeDefn = parse_tree_abstract_type(_)
; TypeDefn = parse_tree_eqv_type(_)
; TypeDefn = parse_tree_foreign_type(_)
; TypeDefn = parse_tree_solver_type(_)
)
;
(
TypeDefn = parse_tree_du_type(DetailsDu),
DetailsDu = type_details_du(Ctors, _, _)
;
TypeDefn = parse_tree_sub_type(DetailsSub),
DetailsSub = type_details_sub(_, Ctors)
),
list.foldl2(check_functor_ambiguities(RecompAvail, TypeCtor),
one_or_more_to_list(Ctors), !MaybeStoppingReason, !Info)
).
:- pred check_functor_ambiguities(recomp_avail::in, type_ctor::in,
constructor::in,
maybe(recompile_reason)::in, maybe(recompile_reason)::out,
recompilation_check_info::in, recompilation_check_info::out) is det.
check_functor_ambiguities(RecompAvail, TypeCtor, Ctor,
!MaybeStoppingReason, !Info) :-
Ctor = ctor(_, _, Name, Args, Arity, _),
ResolvedCtor = resolved_functor_data_constructor(TypeCtor),
check_functor_ambiguities_by_name(RecompAvail, Name,
match_arity_exact(Arity), ResolvedCtor, !MaybeStoppingReason, !Info),
ConsCtor = cons_ctor(Name, Arity, TypeCtor),
FieldAccessResolvedCtor =
resolved_functor_field_access_func(ConsCtor),
list.foldl2(
check_field_ambiguities(RecompAvail, FieldAccessResolvedCtor),
Args, !MaybeStoppingReason, !Info).
:- pred check_field_ambiguities(recomp_avail::in,
resolved_functor::in, constructor_arg::in,
maybe(recompile_reason)::in, maybe(recompile_reason)::out,
recompilation_check_info::in, recompilation_check_info::out) is det.
check_field_ambiguities(RecompAvail, ResolvedCtor, CtorArg,
!MaybeStoppingReason, !Info) :-
CtorArg = ctor_arg(MaybeCtorFieldName, _, _),
(
MaybeCtorFieldName = no
;
MaybeCtorFieldName = yes(CtorFieldName),
CtorFieldName = ctor_field_name(FieldName, _Ctxt),
% XXX The arities to match below will need to change if we ever
% allow taking the address of field access functions.
field_access_function_name(get, FieldName, ExtractFuncName),
field_access_function_name(set, FieldName, UpdateFuncName),
check_functor_ambiguities_by_name(RecompAvail, ExtractFuncName,
match_arity_exact(1), ResolvedCtor, !MaybeStoppingReason, !Info),
check_functor_ambiguities_by_name(RecompAvail, UpdateFuncName,
match_arity_exact(2), ResolvedCtor, !MaybeStoppingReason, !Info)
).
% Predicates and functions used as functors can match any arity
% less than or equal to the predicate or function's arity.
:- type functor_match_arity
---> match_arity_exact(arity)
; match_arity_less_than_or_equal(arity)
; match_arity_any.
:- pred check_functor_ambiguities_by_name(recomp_avail::in,
sym_name::in, functor_match_arity::in, resolved_functor::in,
maybe(recompile_reason)::in, maybe(recompile_reason)::out,
recompilation_check_info::in, recompilation_check_info::out) is det.
check_functor_ambiguities_by_name(RecompAvail, Name, MatchArity, ResolvedCtor,
!MaybeStoppingReason, !Info) :-
(
!.MaybeStoppingReason = yes(_)
;
!.MaybeStoppingReason = no,
UsedItems = !.Info ^ rci_used_items,
UnqualName = unqualify_name(Name),
UsedCtors = UsedItems ^ rui_functors,
( if map.search(UsedCtors, UnqualName, UsedCtorAL) then
check_functor_ambiguities_2(RecompAvail, Name, MatchArity,
ResolvedCtor, UsedCtorAL, no, !:MaybeStoppingReason, !Info)
else
!:MaybeStoppingReason = no
)
).
:- pred check_functor_ambiguities_2(recomp_avail::in, sym_name::in,
functor_match_arity::in, resolved_functor::in,
assoc_list(arity, resolved_functor_map)::in,
maybe(recompile_reason)::in, maybe(recompile_reason)::out,
recompilation_check_info::in, recompilation_check_info::out) is det.
check_functor_ambiguities_2(_, _, _, _, [], !MaybeStoppingReason, !Info).
check_functor_ambiguities_2(RecompAvail, Name, MatchArity, ResolvedCtor,
[Arity - UsedCtorMap | UsedCtorAL], !MaybeStoppingReason, !Info) :-
(
!.MaybeStoppingReason = yes(_)
;
!.MaybeStoppingReason = no,
(
MatchArity = match_arity_exact(ArityToMatch),
( if ArityToMatch = Arity then
Check = yes,
Continue = no
else
Check = no,
( if Arity < ArityToMatch then
Continue = yes
else
Continue = no
)
)
;
MatchArity = match_arity_less_than_or_equal(ArityToMatch),
( if Arity =< ArityToMatch then
Check = yes,
Continue = yes
else
Check = no,
Continue = no
)
;
MatchArity = match_arity_any,
Check = yes,
Continue = yes
),
(
Check = yes,
map.foldl2(
check_functor_ambiguity(RecompAvail, Name, Arity,
ResolvedCtor),
UsedCtorMap, no, !:MaybeStoppingReason, !Info)
;
Check = no
),
(
Continue = yes,
check_functor_ambiguities_2(RecompAvail, Name, MatchArity,
ResolvedCtor, UsedCtorAL, !MaybeStoppingReason, !Info)
;
Continue = no
)
).
:- pred check_functor_ambiguity(recomp_avail::in,
sym_name::in, arity::in, resolved_functor::in,
module_qualifier::in, set(resolved_functor)::in,
maybe(recompile_reason)::in, maybe(recompile_reason)::out,
recompilation_check_info::in, recompilation_check_info::out) is det.
check_functor_ambiguity(RecompAvail, SymName, Arity, ResolvedCtor,
OldModuleQualifier, OldResolvedCtors, !MaybeStoppingReason, !Info) :-
(
!.MaybeStoppingReason = yes(_)
;
!.MaybeStoppingReason = no,
( if
% XXX RECOMP401 This logic is ancient, and may do the wrong thing
% with most values of RecompAvail, since those values did not exist
% when the original version of this was written.
( RecompAvail = recomp_avail_int_use
; RecompAvail = recomp_avail_imp_use
),
% XXX This is a bit conservative in the case of partially qualified
% names but that hopefully won't come up too often.
OldModuleQualifier = unqualified("")
then
!:MaybeStoppingReason = no
else if
Name = unqualify_name(SymName),
OldName = module_qualify_name(OldModuleQualifier, Name),
partial_sym_name_matches_full(OldName, SymName),
not set.member(ResolvedCtor, OldResolvedCtors)
then
OldModuleQualName = module_qualify_name(OldModuleQualifier, Name),
Reason = recompile_for_functor_ambiguity(OldModuleQualName, Arity,
ResolvedCtor, set.to_sorted_list(OldResolvedCtors)),
record_recompilation_reason(Reason, !:MaybeStoppingReason, !Info)
else
!:MaybeStoppingReason = no
)
).
%---------------------------------------------------------------------------%
:- type recompilation_check_info
---> recompilation_check_info(
rci_module_name :: module_name,
rci_is_inline_sub_module :: bool,
rci_sub_modules :: list(module_name),
rci_have_read_module_maps :: have_read_module_maps,
rci_used_items :: resolved_used_items,
rci_used_typeclasses :: set(recomp_item_name),
rci_modules_to_recompile :: modules_to_recompile,
rci_collect_all_reasons :: bool,
rci_recompilation_reasons :: list(recompile_reason)
).
:- type recompile_reason
---> recompile_for_file_error(
file_name,
list(format_piece)
)
; recompile_for_output_file_not_up_to_date(
file_name
)
; recompile_for_module_changed(
file_name
)
; recompile_for_item_ambiguity(
recomp_item_id, % new item.
list(recomp_item_id) % ambiguous declarations.
)
; recompile_for_functor_ambiguity(
sym_name,
arity,
resolved_functor, % new item.
list(resolved_functor) % ambiguous declarations.
)
; recompile_for_changed_item(
recomp_item_id
)
; recompile_for_removed_item(
recomp_item_id
)
; recompile_for_changed_or_added_instance(
module_name,
recomp_item_name % class name
)
; recompile_for_removed_instance(
module_name,
recomp_item_name % class name
).
:- pred add_module_to_recompile(module_name::in, recompilation_check_info::in,
recompilation_check_info::out) is det.
add_module_to_recompile(Module, !Info) :-
ModulesToRecompile0 = !.Info ^ rci_modules_to_recompile,
(
ModulesToRecompile0 = all_modules
;
ModulesToRecompile0 = some_modules(Modules0),
!Info ^ rci_modules_to_recompile := some_modules([Module | Modules0])
).
:- pred record_read_file_src(module_name::in, file_name::in,
module_timestamp::in, parse_tree_src::in, read_module_errors::in,
recompilation_check_info::in, recompilation_check_info::out) is det.
record_read_file_src(ModuleName, FileName, ModuleTimestamp,
ParseTree, Errors, !Info) :-
HaveReadModuleMaps0 = !.Info ^ rci_have_read_module_maps,
HaveReadModuleMapSrc0 = HaveReadModuleMaps0 ^ hrmm_src,
ModuleTimestamp = module_timestamp(_, Timestamp, _),
map.set(ModuleName,
have_read_module(FileName, yes(Timestamp), ParseTree, Errors),
HaveReadModuleMapSrc0, HaveReadModuleMapSrc),
HaveReadModuleMaps =
HaveReadModuleMaps0 ^ hrmm_src := HaveReadModuleMapSrc,
!Info ^ rci_have_read_module_maps := HaveReadModuleMaps.
:- pred record_read_file_int0(module_name::in, file_name::in,
module_timestamp::in, parse_tree_int0::in, read_module_errors::in,
recompilation_check_info::in, recompilation_check_info::out) is det.
record_read_file_int0(ModuleName, FileName, ModuleTimestamp, ParseTreeInt0,
Errors, !Info) :-
ModuleTimestamp = module_timestamp(_, Timestamp, _),
HaveReadModuleMaps0 = !.Info ^ rci_have_read_module_maps,
HRMM0 = HaveReadModuleMaps0 ^ hrmm_int0,
ReadResult = have_read_module(FileName, yes(Timestamp),
ParseTreeInt0, Errors),
map.set(ModuleName, ReadResult, HRMM0, HRMM),
HaveReadModuleMaps = HaveReadModuleMaps0 ^ hrmm_int0 := HRMM,
!Info ^ rci_have_read_module_maps := HaveReadModuleMaps.
:- pred record_read_file_int1(module_name::in, file_name::in,
module_timestamp::in, parse_tree_int1::in, read_module_errors::in,
recompilation_check_info::in, recompilation_check_info::out) is det.
record_read_file_int1(ModuleName, FileName, ModuleTimestamp, ParseTreeInt1,
Errors, !Info) :-
ModuleTimestamp = module_timestamp(_, Timestamp, _),
HaveReadModuleMaps1 = !.Info ^ rci_have_read_module_maps,
HRMM1 = HaveReadModuleMaps1 ^ hrmm_int1,
ReadResult = have_read_module(FileName, yes(Timestamp),
ParseTreeInt1, Errors),
map.set(ModuleName, ReadResult, HRMM1, HRMM),
HaveReadModuleMaps = HaveReadModuleMaps1 ^ hrmm_int1 := HRMM,
!Info ^ rci_have_read_module_maps := HaveReadModuleMaps.
:- pred record_read_file_int2(module_name::in, file_name::in,
module_timestamp::in, parse_tree_int2::in, read_module_errors::in,
recompilation_check_info::in, recompilation_check_info::out) is det.
record_read_file_int2(ModuleName, FileName, ModuleTimestamp, ParseTreeInt2,
Errors, !Info) :-
ModuleTimestamp = module_timestamp(_, Timestamp, _),
HaveReadModuleMaps2 = !.Info ^ rci_have_read_module_maps,
HRMM2 = HaveReadModuleMaps2 ^ hrmm_int2,
ReadResult = have_read_module(FileName, yes(Timestamp),
ParseTreeInt2, Errors),
map.set(ModuleName, ReadResult, HRMM2, HRMM),
HaveReadModuleMaps = HaveReadModuleMaps2 ^ hrmm_int2 := HRMM,
!Info ^ rci_have_read_module_maps := HaveReadModuleMaps.
:- pred record_read_file_int3(module_name::in, file_name::in,
module_timestamp::in, parse_tree_int3::in, read_module_errors::in,
recompilation_check_info::in, recompilation_check_info::out) is det.
record_read_file_int3(ModuleName, FileName, ModuleTimestamp, ParseTreeInt3,
Errors, !Info) :-
ModuleTimestamp = module_timestamp(_, Timestamp, _),
HaveReadModuleMaps3 = !.Info ^ rci_have_read_module_maps,
HRMM3 = HaveReadModuleMaps3 ^ hrmm_int3,
ReadResult = have_read_module(FileName, yes(Timestamp),
ParseTreeInt3, Errors),
map.set(ModuleName, ReadResult, HRMM3, HRMM),
HaveReadModuleMaps = HaveReadModuleMaps3 ^ hrmm_int3 := HRMM,
!Info ^ rci_have_read_module_maps := HaveReadModuleMaps.
%---------------------------------------------------------------------------%
:- pred maybe_write_recompilation_message(globals::in,
io.text_output_stream::in,
pred(io.text_output_stream, io, io)::in(pred(in, di, uo) is det),
io::di, io::uo) is det.
maybe_write_recompilation_message(Globals, Stream, P, !IO) :-
globals.lookup_bool_option(Globals, verbose_recompilation, Verbose),
(
Verbose = yes,
P(Stream, !IO)
;
Verbose = no
).
:- pred write_recompile_reason(globals::in, io.text_output_stream::in,
module_name::in, recompile_reason::in, io::di, io::uo) is det.
write_recompile_reason(Globals, Stream, ThisModuleName, Reason, !IO) :-
PrefixPieces = [words("Recompiling module"),
qual_sym_name(ThisModuleName), suffix(":"), nl],
(
Reason = recompile_for_file_error(_FileName, Pieces)
% Pieces should mention FileName.
;
Reason = recompile_for_output_file_not_up_to_date(FileName),
Pieces = [words("output file"), quote(FileName),
words("is not up to date."), nl]
;
Reason = recompile_for_module_changed(FileName),
Pieces = [words("file"), quote(FileName), words("has changed."), nl]
;
Reason = recompile_for_item_ambiguity(Item, AmbiguousItems),
ItemPieces = describe_item(Item),
AmbiguousItemPieces = component_lists_to_pieces("and",
list.map(describe_item, AmbiguousItems)),
Pieces = [words("addition of") | ItemPieces]
++ [words("could cause an ambiguity with")]
++ AmbiguousItemPieces ++ [suffix("."), nl]
;
Reason = recompile_for_functor_ambiguity(SymName, Arity,
Functor, AmbiguousFunctors),
FunctorPieces = describe_resolved_functor(SymName, Arity, Functor),
AmbiguousFunctorPieces = component_lists_to_pieces("and",
list.map(describe_resolved_functor(SymName, Arity),
AmbiguousFunctors)),
Pieces = [words("addition of") | FunctorPieces]
++ [words("could cause an ambiguity with")]
++ AmbiguousFunctorPieces ++ [suffix("."), nl]
;
Reason = recompile_for_changed_item(Item),
Pieces = describe_item(Item) ++ [words("was modified."), nl]
;
Reason = recompile_for_removed_item(Item),
Pieces = describe_item(Item) ++ [words("was removed."), nl]
;
Reason = recompile_for_changed_or_added_instance(ModuleName,
recomp_item_name(ClassName, ClassArity)),
Pieces = [words("an instance for class"),
qual_sym_name_arity(sym_name_arity(ClassName, ClassArity)),
words("in module"), qual_sym_name(ModuleName),
words("was added or modified."), nl]
;
Reason = recompile_for_removed_instance(ModuleName,
recomp_item_name(ClassName, ClassArity)),
Pieces = [words("an instance for class "),
qual_sym_name_arity(sym_name_arity(ClassName, ClassArity)),
words("in module"), qual_sym_name(ModuleName),
words("was removed."), nl]
),
AllPieces = PrefixPieces ++ Pieces,
Spec = simplest_no_context_spec($pred, severity_informational,
phase_read_files, AllPieces),
% Since these messages are informational, there should be no warnings
% or errors.
write_error_spec(Stream, Globals, Spec, !IO).
:- func describe_item(recomp_item_id) = list(format_piece).
describe_item(ItemId) = Pieces :-
ItemId = recomp_item_id(ItemType0, ItemName),
( if is_body_of_item(ItemType0, ItemType1) then
string_to_recomp_item_type(ItemTypeStr, ItemType1),
ItemPieces = [words("body of"), words(ItemTypeStr)]
else
string_to_recomp_item_type(ItemTypeStr, ItemType0),
ItemPieces = [words(ItemTypeStr)]
),
ItemName = recomp_item_name(SymName, Arity),
Pieces = ItemPieces ++
[qual_sym_name_arity(sym_name_arity(SymName, Arity))].
:- pred is_body_of_item(recomp_item_type::in, recomp_item_type::out)
is semidet.
is_body_of_item(recomp_type_defn, recomp_type_name).
:- func describe_resolved_functor(sym_name, arity, resolved_functor) =
list(format_piece).
describe_resolved_functor(SymName, Arity, ResolvedFunctor) = Pieces :-
(
ResolvedFunctor = resolved_functor_pred_or_func(_, PredOrFunc,
ModuleName, PredArity),
Name = unqualify_name(SymName),
PFStr = pred_or_func_to_full_str(PredOrFunc),
user_arity_pred_form_arity(PredOrFunc, user_arity(UserArity),
PredArity),
SNA = sym_name_arity(qualified(ModuleName, Name), UserArity),
Pieces = [words(PFStr), qual_sym_name_arity(SNA)]
;
ResolvedFunctor = resolved_functor_data_constructor(TypeCtor),
SNA = sym_name_arity(SymName, Arity),
Pieces = [words("constructor"), unqual_sym_name_arity(SNA),
words("of type"), qual_type_ctor(TypeCtor)]
;
ResolvedFunctor = resolved_functor_field_access_func(ConsCtor),
SNA = sym_name_arity(SymName, Arity),
ConsCtor = cons_ctor(ConsName, ConsArity, TypeCtor),
ConsSNA = sym_name_arity(ConsName, ConsArity),
Pieces = [words("field access function"), unqual_sym_name_arity(SNA),
words("for constructor"), unqual_sym_name_arity(ConsSNA),
words("of type"), qual_type_ctor(TypeCtor)]
).
%---------------------------------------------------------------------------%
:- pred record_recompilation_reason(recompile_reason::in,
maybe(recompile_reason)::out,
recompilation_check_info::in, recompilation_check_info::out) is det.
record_recompilation_reason(Reason, MaybeStoppingReason, !Info) :-
CollectAllReasons = !.Info ^ rci_collect_all_reasons,
(
CollectAllReasons = yes,
% XXX Note that many places in the code above record a stopping reason
% *without* either calling this predicate or checking the value of
% CollectAllReasons themselves, so CollectAllReasons being yes
% does NOT guarantee that we in fact collect all reasons to recompile.
MaybeStoppingReason = no,
!Info ^ rci_recompilation_reasons :=
[Reason | !.Info ^ rci_recompilation_reasons]
;
CollectAllReasons = no,
MaybeStoppingReason = yes(Reason)
).
%---------------------------------------------------------------------------%
:- type ambiguity_checkables
---> ambiguity_checkables(
% NOTE We should consider making the types of the first
% three fields type_ctor_defn_map, inst_ctor_defn_map and
% mode_ctor_defn_map respectively. However, before we do that,
% we need to decide exactly how we want to handle any entries
% in the implementation section versions of those maps.
% I (zs) think it is quite likely that the original code
% of this module did not consider the treatment of such entries
% thoroughly enough.
%
% Consider that the original motivation to put type
% definitions into the implementation sections of .int files
% was to give the compiler the information it needs to decide
% on the correct representation of values of the type,
% especially in the context of equivalence types involving
% floats, which at the time were stored in two words
% (as 64 bit entities on a 32 bit platform). However,
% such type definition items specify non-user-visible
% information, and as such should not be able to affect
% which type names are ambiguous and which are not.
% And yet the code of this module has always processed
% type definition items without regard to which section
% of an interface file they occurred in. (It is possible
% that the reason for this is that when this code was first
% written, interface files did not *have* implementation
% sections.)
list(item_type_defn_info),
list(item_inst_defn_info),
list(item_mode_defn_info),
list(item_typeclass_info),
list(item_pred_decl_info)
).
:- pred get_ambiguity_checkables_int0(parse_tree_int0::in,
ambiguity_checkables::out) is det.
get_ambiguity_checkables_int0(ParseTreeInt0, Checkables) :-
ParseTreeInt0 = parse_tree_int0(_ModuleName, _ModuleNameContext,
_MaybeVersionNumbers, _InclMap, _ImportUseMap, _IntFIMs, _ImpFIMs,
TypeCtorCheckedMap, InstCtorCheckedMap, ModeCtorCheckedMap,
IntTypeClasses, _IntInstances,
IntPredDecls, _IntModeDecls, _IntDeclPragmas, _IntPromises,
ImpTypeClasses, _ImpInstances, ImpPredDecls, _ImpModeDecls,
_ImpDeclPragmas, _ImpPromises),
type_ctor_checked_map_get_src_defns(TypeCtorCheckedMap,
IntTypeDefns, ImpTypeDefns, _ImpForeignEnums),
inst_ctor_checked_map_get_src_defns(InstCtorCheckedMap,
IntInstDefns, ImpInstDefns),
mode_ctor_checked_map_get_src_defns(ModeCtorCheckedMap,
IntModeDefns, ImpModeDefns),
ItemTypeDefns = IntTypeDefns ++ ImpTypeDefns,
ItemInstDefns = IntInstDefns ++ ImpInstDefns,
ItemModeDefns = IntModeDefns ++ ImpModeDefns,
ItemTypeClasses = IntTypeClasses ++ ImpTypeClasses,
ItemPredDecls = IntPredDecls ++ ImpPredDecls,
Checkables = ambiguity_checkables(ItemTypeDefns,
ItemInstDefns, ItemModeDefns, ItemTypeClasses, ItemPredDecls).
:- pred get_ambiguity_checkables_int1(parse_tree_int1::in,
ambiguity_checkables::out) is det.
get_ambiguity_checkables_int1(ParseTreeInt1, Checkables) :-
ParseTreeInt1 = parse_tree_int1(_ModuleName, _ModuleNameContext,
_MaybeVersionNumbers, _InclMap, _ImportUseMap, _IntFIMs, _ImpFIMs,
TypeDefnCheckedMap, InstDefnCheckedMap, ModeDefnCheckedMap,
IntTypeClasses, _IntItemInstances, IntPredDecls, _IntModeDecls,
_IntDeclPragmas, _IntPromises, _IntTypeRepnMap, ImpTypeClasses),
type_ctor_checked_map_get_src_defns(TypeDefnCheckedMap,
IntTypeDefns, ImpTypeDefns, _ImpForeignEnums),
inst_ctor_checked_map_get_src_defns(InstDefnCheckedMap,
IntInstDefns, ImpInstDefns),
mode_ctor_checked_map_get_src_defns(ModeDefnCheckedMap,
IntModeDefns, ImpModeDefns),
expect(unify(ImpInstDefns, []), $pred, "ImpInstDefns != []"),
expect(unify(ImpModeDefns, []), $pred, "ImpModeDefns != []"),
ItemTypeDefns = IntTypeDefns ++ ImpTypeDefns,
ItemInstDefns = IntInstDefns,
ItemModeDefns = IntModeDefns,
ItemTypeClasses = IntTypeClasses ++ ImpTypeClasses,
ItemPredDecls = IntPredDecls,
Checkables = ambiguity_checkables(ItemTypeDefns,
ItemInstDefns, ItemModeDefns, ItemTypeClasses, ItemPredDecls).
:- pred get_ambiguity_checkables_int2(parse_tree_int2::in,
ambiguity_checkables::out) is det.
get_ambiguity_checkables_int2(ParseTreeInt2, Checkables) :-
ParseTreeInt2 = parse_tree_int2(_ModuleName, _ModuleNameContext,
_MaybeVersionNumbers, _InclMap, _ImportUseMap, _IntFIMs, _ImpFIMs,
TypeDefnCheckedMap, InstDefnCheckedMap, ModeDefnCheckedMap,
IntItemTypeClasses, _IntItemInstances, _IntTypeRepnMap),
type_ctor_checked_map_get_src_defns(TypeDefnCheckedMap,
IntTypeDefns, ImpTypeDefns, _ImpForeignEnums),
inst_ctor_checked_map_get_src_defns(InstDefnCheckedMap,
IntInstDefns, ImpInstDefns),
mode_ctor_checked_map_get_src_defns(ModeDefnCheckedMap,
IntModeDefns, ImpModeDefns),
expect(unify(ImpInstDefns, []), $pred, "ImpInstDefns != []"),
expect(unify(ImpModeDefns, []), $pred, "ImpModeDefns != []"),
ItemTypeDefns = IntTypeDefns ++ ImpTypeDefns,
ItemInstDefns = IntInstDefns,
ItemModeDefns = IntModeDefns,
ItemTypeClasses = IntItemTypeClasses,
ItemPredDecls = [],
Checkables = ambiguity_checkables(ItemTypeDefns,
ItemInstDefns, ItemModeDefns, ItemTypeClasses, ItemPredDecls).
:- pred get_ambiguity_checkables_int3(parse_tree_int3::in,
ambiguity_checkables::out) is det.
get_ambiguity_checkables_int3(ParseTreeInt3, Checkables) :-
ParseTreeInt3 = parse_tree_int3(_ModuleName, _ModuleNameContext,
_InclMap, _ImportUseMap,
TypeCtorCheckedMap, InstCtorCheckedMap, ModeCtorCheckedMap,
IntTypeClasses, _IntInstances, _TypeRepnMap),
type_ctor_checked_map_get_src_defns(TypeCtorCheckedMap,
IntTypeDefns, ImpTypeDefns, _ImpForeignEnums),
inst_ctor_checked_map_get_src_defns(InstCtorCheckedMap,
IntInstDefns, ImpInstDefns),
mode_ctor_checked_map_get_src_defns(ModeCtorCheckedMap,
IntModeDefns, ImpModeDefns),
expect(unify(ImpTypeDefns, []), $pred, "ImpTypeDefns != []"),
expect(unify(ImpInstDefns, []), $pred, "ImpInstDefns != []"),
expect(unify(ImpModeDefns, []), $pred, "ImpModeDefns != []"),
IntPredDecls = [],
Checkables = ambiguity_checkables(IntTypeDefns,
IntInstDefns, IntModeDefns, IntTypeClasses, IntPredDecls).
%---------------------------------------------------------------------------%
:- end_module recompilation.check.
%---------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink