mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-18 02:43:40 +00:00
Code Issues Projects Releases Wiki Activity
Files
083d376e6598628362ee91c2da170febd83590f4
mercury/compiler/recompilation.version.m
Zoltan Somogyi 6bdd8b84ee Move maybe_changed to maybe_succeeded.m and rename it. 
compiler/maybe_util.m:
    Move the maybe_changed type from several modules of the compiler
    to maybe_succeeded.m, and rename it to maybe_util.m.

compiler/libs.m:
compiler/notes/compiler_design.html:
    Implement and document the rename.

compiler/common.m:
compiler/compile_target_code.m:
compiler/decide_type_repn.m:
compiler/det_analysis.m:
compiler/det_util.m:
compiler/equiv_type.m:
compiler/equiv_type_hlds.m:
compiler/file_util.m:
compiler/llds_out_file.m:
compiler/make.build.m:
compiler/make.dependencies.m:
compiler/make.module_dep_file.m:
compiler/make.module_target.m:
compiler/make.program_target.m:
compiler/make.top_level.m:
compiler/make.track_flags.m:
compiler/mercury_compile_llds_back_end.m:
compiler/mercury_compile_main.m:
compiler/mercury_compile_mlds_back_end.m:
compiler/mlds_to_c_file.m:
compiler/mlds_to_c_type.m:
compiler/mlds_to_cs_file.m:
compiler/mlds_to_java_file.m:
compiler/module_cmds.m:
compiler/parse_tree_out.m:
compiler/process_util.m:
compiler/recompilation.version.m:
compiler/write_module_interface_files.m:
    Conform to the changes above.
2023-04-21 17:24:30 +10:00

1828 lines
74 KiB
Mathematica
Raw Blame History

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2001-2012 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_version.m.
% Main author: stayl.
%
% Compute version numbers for program items in interface files.
%
%---------------------------------------------------------------------------%
:- module recompilation.version.
:- interface.
:- import_module libs.
:- import_module libs.timestamp.
:- import_module parse_tree.
:- import_module parse_tree.maybe_error.
:- import_module parse_tree.prog_item.
:- import_module maybe.
:- import_module term.
%---------------------------------------------------------------------------%
% compute_version_numbers_intN(MaybeOldParseTreeIntN,
% CurParseTreeIntNTimeStamp, CurParseTreeIntN, VersionNumbers).
%
:- pred compute_version_numbers_int0(maybe(parse_tree_int0)::in,
timestamp::in, parse_tree_int0::in, module_item_version_numbers::out)
is det.
:- pred compute_version_numbers_int1(maybe(parse_tree_int1)::in,
timestamp::in, parse_tree_int1::in, module_item_version_numbers::out)
is det.
:- pred compute_version_numbers_int2(maybe(parse_tree_int2)::in,
timestamp::in, parse_tree_int2::in, module_item_version_numbers::out)
is det.
:- func module_item_version_numbers_to_string(module_item_version_numbers)
= string.
% The version number for the format of the version numbers
% written to the interface files.
%
:- func module_item_version_numbers_version_number = int.
% Parse a term that maps item ids to timestamps. These terms
% look like this:
%
% {
% type(
% state_mc/0 - "2015-10-16 08:51:02",
% state_no/0 - "2015-10-16 08:51:02",
% transition/0 - "2015-10-16 08:51:02",
% transitions/0 - "2015-10-16 08:51:02"
% ),
% type_body(
% state_mc/0 - "2015-10-16 08:51:02",
% state_no/0 - "2015-10-16 08:51:02",
% transition/0 - "2015-10-16 08:51:02",
% transitions/0 - "2015-10-16 08:51:02"
% ),
% inst(
% atom_transition/0 - "2015-10-16 08:51:02",
% atom_transitions/0 - "2015-10-16 08:51:02",
% null_transition/0 - "2015-10-16 08:51:02",
% null_transition_free_state_mc/0 - "2015-10-16 08:51:02",
% null_transitions/0 - "2015-10-16 08:51:02"
% )
% }
%
:- pred parse_module_item_version_numbers(term::in,
maybe1(module_item_version_numbers)::out) is det.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module libs.maybe_util.
:- import_module parse_tree.convert_parse_tree.
:- import_module parse_tree.error_spec.
:- import_module parse_tree.item_util.
:- import_module parse_tree.parse_sym_name.
:- import_module parse_tree.parse_tree_out_info.
:- import_module parse_tree.parse_tree_out_sym_name.
:- import_module parse_tree.parse_tree_out_term.
:- import_module parse_tree.parse_tree_to_term.
:- import_module parse_tree.parse_util.
:- import_module parse_tree.prog_type.
:- import_module parse_tree.prog_type_subst.
:- import_module parse_tree.prog_util.
:- import_module assoc_list.
:- import_module cord.
:- import_module list.
:- import_module map.
:- import_module multi_map.
:- import_module one_or_more.
:- import_module pair.
:- import_module require.
:- import_module string.
:- import_module term_context.
:- import_module term_int.
:- import_module term_subst.
:- import_module term_unify.
:- import_module varset.
%---------------------------------------------------------------------------%
compute_version_numbers_int0(MaybeOldParseTreeInt0,
CurFileTime, CurParseTreeInt0, NewVersionNumbers) :-
gather_items_in_parse_tree_int0(CurParseTreeInt0, CurGatherResults),
( if
MaybeOldParseTreeInt0 = yes(OldParseTreeInt0),
OldParseTreeInt0 ^ pti0_maybe_version_numbers
= version_numbers(OldVersionNumbers)
then
gather_items_in_parse_tree_int0(OldParseTreeInt0, OldGatherResults),
MaybeOldVersionNumbersGatherResults =
yes({OldVersionNumbers, OldGatherResults})
else
MaybeOldVersionNumbersGatherResults = no
),
update_version_numbers(MaybeOldVersionNumbersGatherResults,
CurFileTime, CurGatherResults, NewVersionNumbers).
compute_version_numbers_int1(MaybeOldParseTreeInt1,
CurFileTime, CurParseTreeInt1, NewVersionNumbers) :-
gather_items_in_parse_tree_int1(CurParseTreeInt1, CurGatherResults),
( if
MaybeOldParseTreeInt1 = yes(OldParseTreeInt1),
OldParseTreeInt1 ^ pti1_maybe_version_numbers
= version_numbers(OldVersionNumbers)
then
gather_items_in_parse_tree_int1(OldParseTreeInt1, OldGatherResults),
MaybeOldVersionNumbersGatherResults =
yes({OldVersionNumbers, OldGatherResults})
else
MaybeOldVersionNumbersGatherResults = no
),
update_version_numbers(MaybeOldVersionNumbersGatherResults,
CurFileTime, CurGatherResults, NewVersionNumbers).
compute_version_numbers_int2(MaybeOldParseTreeInt2,
CurFileTime, CurParseTreeInt2, NewVersionNumbers) :-
gather_items_in_parse_tree_int2(CurParseTreeInt2, CurGatherResults),
( if
MaybeOldParseTreeInt2 = yes(OldParseTreeInt2),
OldParseTreeInt2 ^ pti2_maybe_version_numbers
= version_numbers(OldVersionNumbers)
then
gather_items_in_parse_tree_int2(OldParseTreeInt2, OldGatherResults),
MaybeOldVersionNumbersGatherResults =
yes({OldVersionNumbers, OldGatherResults})
else
MaybeOldVersionNumbersGatherResults = no
),
update_version_numbers(MaybeOldVersionNumbersGatherResults,
CurFileTime, CurGatherResults, NewVersionNumbers).
%---------------------%
:- pred update_version_numbers(
maybe({module_item_version_numbers, gathered_items})::in,
timestamp::in, gathered_items::in,
module_item_version_numbers::out) is det.
update_version_numbers(MaybeOldVersionNumbersGatherResults,
CurSourceFileTime, CurGatheredItems, NewVersionNumbers) :-
(
MaybeOldVersionNumbersGatherResults =
yes({OldVersionNumbers, OldGatheredItems})
;
MaybeOldVersionNumbersGatherResults = no,
% There were no old version numbers, so every item gets
% the same timestamp as the source module.
% XXX ITEM_LIST In which case, the call to compute_item_version_numbers
% below is mostly a waste of time, since we could get the same job done
% more quickly without doing a lot of lookups in empty maps.
OldVersionNumbers = module_item_version_numbers(map.init, map.init,
map.init, map.init, map.init, map.init, map.init, map.init),
OldGatheredItems = gathered_items(map.init, map.init,
map.init, map.init, map.init, map.init, map.init, map.init)
),
compute_item_version_numbers(CurSourceFileTime,
OldGatheredItems, CurGatheredItems,
OldVersionNumbers, NewVersionNumbers).
%---------------------%
:- pred compute_item_version_numbers(timestamp::in,
gathered_items::in, gathered_items::in,
module_item_version_numbers::in, module_item_version_numbers::out) is det.
compute_item_version_numbers(SourceFileTime,
OldGatheredItems, CurGatheredItems,
OldVersionNumbers, NewVersionNumbers) :-
OldGatheredItems = gathered_items(OldTypeMap, OldTBodyMap,
OldInstMap, OldModeMap, OldClassMap, OldInstanceMap,
OldPredMap, OldFuncMap),
CurGatheredItems = gathered_items(CurTypeMap, CurTBodyMap,
CurInstMap, CurModeMap, CurClassMap, CurInstanceMap,
CurPredMap, CurFuncMap),
OldVersionNumbers = module_item_version_numbers(OldTypeVMap, OldTBodyVMap,
OldInstVMap, OldModeVMap, OldClassVMap, OldInstanceVMap,
OldPredVMap, OldFuncVMap),
compute_name_arity_version_map(SourceFileTime,
OldTypeMap, OldTypeVMap, CurTypeMap, NewTypeVMap),
compute_name_arity_version_map(SourceFileTime,
OldTBodyMap, OldTBodyVMap, CurTBodyMap, NewTBodyVMap),
compute_name_arity_version_map(SourceFileTime,
OldInstMap, OldInstVMap, CurInstMap, NewInstVMap),
compute_name_arity_version_map(SourceFileTime,
OldModeMap, OldModeVMap, CurModeMap, NewModeVMap),
compute_name_arity_version_map(SourceFileTime,
OldClassMap, OldClassVMap, CurClassMap, NewClassVMap),
compute_item_name_version_map(SourceFileTime,
OldInstanceMap, OldInstanceVMap, CurInstanceMap, NewInstanceVMap),
compute_name_arity_version_map(SourceFileTime,
OldPredMap, OldPredVMap, CurPredMap, NewPredVMap),
compute_name_arity_version_map(SourceFileTime,
OldFuncMap, OldFuncVMap, CurFuncMap, NewFuncVMap),
NewVersionNumbers = module_item_version_numbers(NewTypeVMap, NewTBodyVMap,
NewInstVMap, NewModeVMap, NewClassVMap, NewInstanceVMap,
NewPredVMap, NewFuncVMap).
:- pred compute_name_arity_version_map(timestamp::in,
gathered_item_multi_map_na::in, name_arity_version_map::in,
gathered_item_multi_map_na::in, name_arity_version_map::out) is det.
compute_name_arity_version_map(SourceFileTime,
OldGatheredMap, OldVersionMap, CurGatheredMap, NewVersionMap) :-
map.map_values(
compute_name_arity_version_map_entry(SourceFileTime,
OldGatheredMap, OldVersionMap),
CurGatheredMap, NewVersionMap).
:- pred compute_name_arity_version_map_entry(timestamp::in,
gathered_item_multi_map_na::in, name_arity_version_map::in,
name_arity::in, assoc_list(module_section, item)::in,
version_number::out) is det.
compute_name_arity_version_map_entry(SourceFileTime,
OldGatheredMap, OldVersionMap, NameArity, CurItems, TimeStamp) :-
( if
map.search(OldGatheredMap, NameArity, OldItems),
% We call order_items on the items in both the interface and the
% implementation of the current parse tree, but doing the same for
% the previous parse tree would be overkill. However, for some "item"
% types, such as predicate_item, OldItems and CurItems may contain
% more than one prog_item.item. We don't want this artificially-created
% difference in the ORDER of those items to count as a difference
% that requires a recompilation.
list.sort(OldItems, SortedOldItems),
list.sort(CurItems, SortedCurItems),
are_items_changed(SortedOldItems, SortedCurItems, unchanged),
map.search(OldVersionMap, NameArity, OldVersionNumber)
then
TimeStamp = OldVersionNumber
else
TimeStamp = SourceFileTime
).
:- pred compute_item_name_version_map(timestamp::in,
gathered_item_multi_map_in::in, recomp_item_name_version_map::in,
gathered_item_multi_map_in::in, recomp_item_name_version_map::out) is det.
compute_item_name_version_map(SourceFileTime,
OldGatheredMap, OldVersionMap, CurGatheredMap, NewVersionMap) :-
map.map_values(
compute_item_name_version_map_entry(SourceFileTime,
OldGatheredMap, OldVersionMap),
CurGatheredMap, NewVersionMap).
:- pred compute_item_name_version_map_entry(timestamp::in,
gathered_item_multi_map_in::in, recomp_item_name_version_map::in,
recomp_item_name::in, assoc_list(module_section, item)::in,
version_number::out) is det.
compute_item_name_version_map_entry(SourceFileTime,
OldGatheredMap, OldVersionMap, ItemName, CurItems, TimeStamp) :-
( if
map.search(OldGatheredMap, ItemName, OldItems),
% We call order_items on the items in both the interface and the
% implementation of the current parse tree, but doing the same for
% the previous parse tree would be overkill. However, for some "item"
% types, such as predicate_item, OldItems and CurItems may contain
% more than one prog_item.item. We don't want this artificially-created
% difference in the ORDER of those items to count as a difference
% that requires a recompilation.
list.sort(OldItems, SortedOldItems),
list.sort(CurItems, SortedCurItems),
are_items_changed(SortedOldItems, SortedCurItems, unchanged),
map.search(OldVersionMap, ItemName, OldVersionNumber)
then
TimeStamp = OldVersionNumber
else
TimeStamp = SourceFileTime
).
%---------------------------------------------------------------------------%
:- pred gather_items_in_parse_tree_int0(parse_tree_int0::in,
gathered_items::out) is det.
gather_items_in_parse_tree_int0(ParseTreeInt0, GatheredItems) :-
ParseTreeInt0 = parse_tree_int0(_ModuleName, _ModuleNameContext,
_MaybeVersionNumbers, _InclMap,
_ImportUseMap, _IntFIMSpecs, _ImpFIMSpecs,
TypeCtorCheckedMap, InstCtorCheckedMap, ModeCtorCheckedMap,
IntTypeClasses, IntInstances, IntPredDecls, IntModeDecls,
IntDeclPragmas, _IntPromises,
ImpTypeClasses, ImpInstances, ImpPredDecls, ImpModeDecls,
ImpDeclPragmas, _ImpPromises),
some [!TypeNameMap, !TypeDefnMap, !InstMap, !ModeMap,
!ClassMap, !InstanceMap,
!PredMap, !FuncMap, !DeclPragmaRecords]
(
map.init(!:TypeNameMap),
map.init(!:TypeDefnMap),
map.init(!:InstMap),
map.init(!:ModeMap),
map.init(!:ClassMap),
map.init(!:InstanceMap),
map.init(!:PredMap),
map.init(!:FuncMap),
!:DeclPragmaRecords = cord.init,
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),
list.foldl2(gather_in_type_defn(ms_interface),
IntTypeDefns, !TypeNameMap, !TypeDefnMap),
list.foldl(gather_in_inst_defn(ms_interface),
IntInstDefns, !InstMap),
list.foldl(gather_in_mode_defn(ms_interface),
IntModeDefns, !ModeMap),
list.foldl(gather_in_typeclass(ms_interface), IntTypeClasses,
!ClassMap),
list.foldl(gather_in_instance(ms_interface), IntInstances,
!InstanceMap),
list.foldl2(gather_in_pred_decl(ms_interface), IntPredDecls,
!PredMap, !FuncMap),
list.foldl2(gather_in_mode_decl(ms_interface), IntModeDecls,
!PredMap, !FuncMap),
list.foldl(gather_in_decl_pragma(ms_interface), IntDeclPragmas,
!DeclPragmaRecords),
% XXX Not gathering promises is a bug.
list.foldl2(gather_in_type_defn(ms_implementation),
ImpTypeDefns, !TypeNameMap, !TypeDefnMap),
list.foldl(gather_in_inst_defn(ms_implementation),
ImpInstDefns, !InstMap),
list.foldl(gather_in_mode_defn(ms_implementation),
ImpModeDefns, !ModeMap),
list.foldl(gather_in_typeclass(ms_implementation), ImpTypeClasses,
!ClassMap),
list.foldl(gather_in_instance(ms_implementation), ImpInstances,
!InstanceMap),
list.foldl2(gather_in_pred_decl(ms_implementation), ImpPredDecls,
!PredMap, !FuncMap),
list.foldl2(gather_in_mode_decl(ms_implementation), ImpModeDecls,
!PredMap, !FuncMap),
% We gather foreign enum info from the type_ctor_defn_maps.
list.foldl(gather_in_decl_pragma(ms_implementation), ImpDeclPragmas,
!DeclPragmaRecords),
% XXX Not gathering promises is a bug.
cord.foldl3(apply_decl_pragma_record, !.DeclPragmaRecords,
!PredMap, !FuncMap, !ClassMap),
GatheredItems = gathered_items(!.TypeNameMap, !.TypeDefnMap,
!.InstMap, !.ModeMap, !.ClassMap, !.InstanceMap,
!.PredMap, !.FuncMap)
).
:- pred gather_items_in_parse_tree_int1(parse_tree_int1::in,
gathered_items::out) is det.
gather_items_in_parse_tree_int1(ParseTreeInt1, GatheredItems) :-
ParseTreeInt1 = parse_tree_int1(_ModuleName, _ModuleNameContext,
_MaybeVersionNumbers, _InclMap,
_ImportUseMap, _IntFIMSpecs, _ImpFIMSpecs,
TypeCtorCheckedMap, InstCtorCheckedMap, ModeCtorCheckedMap,
IntTypeClasses, IntInstances, IntPredDecls, IntModeDecls,
IntDeclPragmas, _IntPromises, IntTypeRepnMap,
ImpTypeClasses),
some [!TypeNameMap, !TypeDefnMap, !InstMap, !ModeMap,
!ClassMap, !InstanceMap,
!PredMap, !FuncMap, !DeclPragmaRecords]
(
map.init(!:TypeNameMap),
map.init(!:TypeDefnMap),
map.init(!:InstMap),
map.init(!:ModeMap),
map.init(!:ClassMap),
map.init(!:InstanceMap),
map.init(!:PredMap),
map.init(!:FuncMap),
!:DeclPragmaRecords = cord.init,
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(ImpInstDefns, []), $pred, "ImpInstDefns != []"),
expect(unify(ImpModeDefns, []), $pred, "ImpModeDefns != []"),
list.foldl2(gather_in_type_defn(ms_interface),
IntTypeDefns, !TypeNameMap, !TypeDefnMap),
list.foldl(gather_in_inst_defn(ms_interface),
IntInstDefns, !InstMap),
list.foldl(gather_in_mode_defn(ms_interface),
IntModeDefns, !ModeMap),
list.foldl(gather_in_typeclass(ms_interface), IntTypeClasses,
!ClassMap),
list.foldl(gather_in_instance(ms_interface), IntInstances,
!InstanceMap),
list.foldl2(gather_in_pred_decl(ms_interface), IntPredDecls,
!PredMap, !FuncMap),
list.foldl2(gather_in_mode_decl(ms_interface), IntModeDecls,
!PredMap, !FuncMap),
list.foldl(gather_in_decl_pragma(ms_interface), IntDeclPragmas,
!DeclPragmaRecords),
% XXX Not gathering promises is a bug.
list.foldl(gather_in_type_repn(ms_interface),
type_ctor_repn_map_to_type_repns(IntTypeRepnMap), !TypeDefnMap),
list.foldl2(gather_in_type_defn(ms_implementation),
ImpTypeDefns, !TypeNameMap, !TypeDefnMap),
% We gather foreign enum info from the type_ctor_defn_maps.
list.foldl(gather_in_typeclass(ms_implementation),
ImpTypeClasses, !ClassMap),
cord.foldl3(apply_decl_pragma_record, !.DeclPragmaRecords,
!PredMap, !FuncMap, !ClassMap),
GatheredItems = gathered_items(!.TypeNameMap, !.TypeDefnMap,
!.InstMap, !.ModeMap, !.ClassMap, !.InstanceMap,
!.PredMap, !.FuncMap)
).
:- pred gather_items_in_parse_tree_int2(parse_tree_int2::in,
gathered_items::out) is det.
gather_items_in_parse_tree_int2(ParseTreeInt2, GatheredItems) :-
ParseTreeInt2 = parse_tree_int2(_ModuleName, _ModuleNameContext,
_MaybeVersionNumbers, _InclMap, _ImportUseMap,
_IntFIMSpecs, _ImpFIMSpecs,
TypeCtorCheckedMap, InstCtorCheckedMap, ModeCtorCheckedMap,
IntTypeClasses, IntInstances, IntTypeRepnMap),
some [!TypeNameMap, !TypeDefnMap, !InstMap, !ModeMap,
!ClassMap, !InstanceMap]
(
map.init(!:TypeNameMap),
map.init(!:TypeDefnMap),
map.init(!:InstMap),
map.init(!:ModeMap),
map.init(!:ClassMap),
map.init(!:InstanceMap),
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(ImpInstDefns, []), $pred, "ImpInstDefns != []"),
expect(unify(ImpModeDefns, []), $pred, "ImpModeDefns != []"),
list.foldl2(gather_in_type_defn(ms_interface),
IntTypeDefns, !TypeNameMap, !TypeDefnMap),
list.foldl(gather_in_inst_defn(ms_interface),
IntInstDefns, !InstMap),
list.foldl(gather_in_mode_defn(ms_interface),
IntModeDefns, !ModeMap),
list.foldl(gather_in_typeclass(ms_interface), IntTypeClasses,
!ClassMap),
list.foldl(gather_in_instance(ms_interface), IntInstances,
!InstanceMap),
% XXX Not gathering promises is a bug.
list.foldl(gather_in_type_repn(ms_interface),
type_ctor_repn_map_to_type_repns(IntTypeRepnMap), !TypeDefnMap),
list.foldl2(gather_in_type_defn(ms_implementation),
ImpTypeDefns, !TypeNameMap, !TypeDefnMap),
map.init(PredMap0),
map.init(FuncMap0),
GatheredItems = gathered_items(!.TypeNameMap, !.TypeDefnMap,
!.InstMap, !.ModeMap, !.ClassMap, !.InstanceMap,
PredMap0, FuncMap0)
).
%---------------------------------------------------------------------------%
:- type gathered_item_multi_map_na ==
multi_map(name_arity, pair(module_section, item)).
:- type gathered_item_multi_map_in ==
multi_map(recomp_item_name, pair(module_section, item)).
% XXX RECOMP The generic item type here should be replaced with
% a different (set of) item-kind-specific types for each field.
:- type gathered_items
---> gathered_items(
gi_type_names :: gathered_item_multi_map_na,
gi_type_defns :: gathered_item_multi_map_na,
gi_modes :: gathered_item_multi_map_na,
gi_insts :: gathered_item_multi_map_na,
gi_typeclasses :: gathered_item_multi_map_na,
gi_instances :: gathered_item_multi_map_in,
gi_predicates :: gathered_item_multi_map_na,
gi_functions :: gathered_item_multi_map_na
).
:- type decl_pragma_record
---> decl_pragma_record(module_section, maybe_pred_or_func_id, item).
% XXX RECOMP Item here should be item_decl_pragma_info.
%---------------------%
:- pred gather_in_type_defn(module_section::in, item_type_defn_info::in,
gathered_item_multi_map_na::in, gathered_item_multi_map_na::out,
gathered_item_multi_map_na::in, gathered_item_multi_map_na::out) is det.
gather_in_type_defn(Section, ItemTypeDefn, !TypeMap, !TypeDefnMap) :-
ItemTypeDefn = item_type_defn_info(SymName, Params, Body,
VarSet, Context, SeqNum),
Item = item_type_defn(ItemTypeDefn),
(
( Body = parse_tree_du_type(_)
; Body = parse_tree_sub_type(_)
),
% XXX Does the value of AbstractDetails matter here?
% XXX TYPE_REPN zs: yes, it should, when it changes in a way that
% affects decisions about the representations of other types
% that include the abstract type. That means that *assuming*
% this value for AbstractDetails is a BUG.
AbstractDetails = abstract_type_general,
AbstractBody = parse_tree_abstract_type(AbstractDetails),
NameItemTypeDefn = item_type_defn_info(SymName, Params, AbstractBody,
VarSet, Context, SeqNum),
NameItem = item_type_defn(NameItemTypeDefn),
BodyItem = Item
;
Body = parse_tree_abstract_type(_),
NameItem = Item,
% The body of an abstract type can be recorded as used when
% generating a call to the automatically generated unification
% procedure.
BodyItem = Item
;
Body = parse_tree_eqv_type(_),
% When we use an equivalence type we always use the body.
NameItem = Item,
BodyItem = Item
;
Body = parse_tree_solver_type(_),
NameItem = Item,
BodyItem = Item
;
Body = parse_tree_foreign_type(_),
NameItem = Item,
BodyItem = Item
),
TypeCtorNA = name_arity(unqualify_name(SymName), list.length(Params)),
multi_map.add(TypeCtorNA, Section - NameItem, !TypeMap),
multi_map.add(TypeCtorNA, Section - BodyItem, !TypeDefnMap).
%---------------------%
:- pred gather_in_inst_defn(module_section::in, item_inst_defn_info::in,
gathered_item_multi_map_na::in, gathered_item_multi_map_na::out) is det.
gather_in_inst_defn(Section, ItemInstDefn, !InstMap) :-
ItemInstDefn = item_inst_defn_info(SymName, Params, _, _, _, _, _),
Item = item_inst_defn(ItemInstDefn),
InstCtorNA = name_arity(unqualify_name(SymName), list.length(Params)),
multi_map.add(InstCtorNA, Section - Item, !InstMap).
%---------------------%
:- pred gather_in_mode_defn(module_section::in, item_mode_defn_info::in,
gathered_item_multi_map_na::in, gathered_item_multi_map_na::out) is det.
gather_in_mode_defn(Section, ItemModeDefn, !ModeMap) :-
ItemModeDefn = item_mode_defn_info(SymName, Params, _, _, _, _),
Item = item_mode_defn(ItemModeDefn),
ModeCtorNA = name_arity(unqualify_name(SymName), list.length(Params)),
multi_map.add(ModeCtorNA, Section - Item, !ModeMap).
%---------------------%
:- pred gather_in_pred_decl(module_section::in, item_pred_decl_info::in,
gathered_item_multi_map_na::in, gathered_item_multi_map_na::out,
gathered_item_multi_map_na::in, gathered_item_multi_map_na::out) is det.
gather_in_pred_decl(Section, ItemPredDecl, !PredMap, !FuncMap) :-
ItemPredDecl = item_pred_decl_info(PredSymName, PredOrFunc, TypesAndModes,
WithType, WithInst, MaybeDetism, Origin, TypeVarSet, InstVarSet,
ExistQVars, Purity, Constraints, Context, SeqNum),
% For predicates or functions defined using `with_type` annotations
% the arity here won't be correct, but equiv_type.m will record
% the dependency on the version number with the `incorrect' arity,
% so this will work.
%
% XXX This is an unreliable method of detecting changes.
% Making it reliable would require at recording for the
% predicate/function the type of the with_type annotation (if any),
% which we don't currently do.
%
% XXX Likewise for with_inst annotations.
(
WithType = no,
adjust_func_arity(PredOrFunc, Arity, list.length(TypesAndModes))
;
WithType = yes(_),
Arity = list.length(TypesAndModes)
),
PredNA = name_arity(unqualify_name(PredSymName), Arity),
split_types_and_modes(TypesAndModes, Types, MaybeModes),
% The code that generates interface files splits combined pred and mode
% declarations. It does this to allow the interface file to remain
% unchanged if/when that programmer doing this splitting manually,
% without making any other changes to the module's interface.
% The code here has to be prepared to compare such the pred_decl/mode_decl
% pair resulting from such as split against a still combined predmode_decl
% item in the source file.
( if
MaybeModes = yes(Modes),
( Modes = [_ | _]
; WithInst = yes(_)
)
then
TypesWithoutModes = list.map((func(Type) = type_only(Type)), Types),
varset.init(EmptyInstVarSet),
ItemPredOnlyDecl = item_pred_decl_info(PredSymName, PredOrFunc,
TypesWithoutModes, WithType, no, no, Origin,
TypeVarSet, EmptyInstVarSet, ExistQVars, Purity, Constraints,
Context, SeqNum),
PredOnlyItem = item_pred_decl(ItemPredOnlyDecl),
(
WithInst = yes(_),
% MaybePredOrFunc needs to be `no' here because when the item
% is read from the interface file, we won't know whether it is
% a predicate or a function mode.
MaybePredOrFunc = no
;
WithInst = no,
MaybePredOrFunc = yes(PredOrFunc)
),
ModeItemModeDecl = item_mode_decl_info(PredSymName, MaybePredOrFunc,
Modes, WithInst, MaybeDetism, InstVarSet, Context, SeqNum),
ModeItem = item_mode_decl(ModeItemModeDecl),
(
PredOrFunc = pf_predicate,
multi_map.add(PredNA, Section - PredOnlyItem, !PredMap),
multi_map.add(PredNA, Section - ModeItem, !PredMap)
;
PredOrFunc = pf_function,
multi_map.add(PredNA, Section - PredOnlyItem, !FuncMap),
multi_map.add(PredNA, Section - ModeItem, !FuncMap)
)
else
PredItem = item_pred_decl(ItemPredDecl),
(
PredOrFunc = pf_predicate,
multi_map.add(PredNA, Section - PredItem, !PredMap)
;
PredOrFunc = pf_function,
multi_map.add(PredNA, Section - PredItem, !FuncMap)
)
).
%---------------------%
:- pred gather_in_mode_decl(module_section::in, item_mode_decl_info::in,
gathered_item_multi_map_na::in, gathered_item_multi_map_na::out,
gathered_item_multi_map_na::in, gathered_item_multi_map_na::out) is det.
gather_in_mode_decl(Section, ItemModeDecl, !PredMap, !FuncMap) :-
% For predicates or functions defined using `with_inst` annotations
% the pred_or_func and arity here won't be correct, but equiv_type.m
% will record the dependency on the version number with the `incorrect'
% pred_or_func and arity, so this will work.
%
% XXX See the comment about with_inst in gather_in_pred_decl.
ItemModeDecl = item_mode_decl_info(SymName, MaybePredOrFunc, ArgModes,
WithInst, _, _, _, _),
Item = item_mode_decl(ItemModeDecl),
( if
MaybePredOrFunc = no,
WithInst = yes(_)
then
ModeNA = name_arity(unqualify_name(SymName), list.length(ArgModes)),
multi_map.add(ModeNA, Section - Item, !PredMap),
multi_map.add(ModeNA, Section - Item, !FuncMap)
else
(
MaybePredOrFunc = yes(PredOrFunc),
adjust_func_arity(PredOrFunc, Arity, list.length(ArgModes)),
ModeNA = name_arity(unqualify_name(SymName), Arity),
(
PredOrFunc = pf_predicate,
multi_map.add(ModeNA, Section - Item, !PredMap)
;
PredOrFunc = pf_function,
multi_map.add(ModeNA, Section - Item, !FuncMap)
)
;
MaybePredOrFunc = no
% We don't have an recomp_item_id, so we cannot gather the item.
% XXX This *will* lead to missing needed recompilations.
)
).
%---------------------%
:- pred gather_in_typeclass(module_section::in, item_typeclass_info::in,
gathered_item_multi_map_na::in, gathered_item_multi_map_na::out) is det.
gather_in_typeclass(Section, ItemTypeClass, !TypeClassMap) :-
ItemTypeClass = item_typeclass_info(ClassName, ClassParams, _, _,
_, _, _, _),
ClassNA = name_arity(unqualify_name(ClassName), list.length(ClassParams)),
Interface = ItemTypeClass ^ tc_class_methods,
(
Interface = class_interface_abstract,
ItemToAdd = item_typeclass(ItemTypeClass)
;
Interface = class_interface_concrete(Decls0),
% See the comment in gather_in_pred_decl for why we split
% any combined predmode declarations here.
DeclsList = list.map(split_class_method_types_and_modes, Decls0),
list.condense(DeclsList, Decls),
SplitItemTypeClass = ItemTypeClass ^ tc_class_methods
:= class_interface_concrete(Decls),
ItemToAdd = item_typeclass(SplitItemTypeClass)
),
multi_map.add(ClassNA, Section - ItemToAdd, !TypeClassMap).
:- func split_class_method_types_and_modes(class_decl) = list(class_decl).
split_class_method_types_and_modes(Decl0) = Decls :-
% Always strip the context from the item -- this is needed
% so the items can be easily tested for equality.
(
Decl0 = class_decl_pred_or_func(PredOrFuncInfo0),
PredOrFuncInfo0 = class_pred_or_func_info(SymName, PredOrFunc,
TypesAndModes, WithType, WithInst, MaybeDetism,
TypeVarSet, InstVarSet, ExistQVars, Purity, Constraints, _Context),
( if
split_types_and_modes(TypesAndModes, Types, MaybeModes),
MaybeModes = yes(Modes),
( Modes = [_ | _]
; WithInst = yes(_)
)
then
TypesWithoutModes =
list.map((func(Type) = type_only(Type)), Types),
(
WithInst = yes(_),
% MaybePredOrFunc needs to be `no' here because when the item
% is read in from the interface file, we won't know whether
% it is a mode for a predicate or a function.
MaybePredOrFunc = no
;
WithInst = no,
MaybePredOrFunc = yes(PredOrFunc)
),
ModeInfo = class_mode_info(SymName, MaybePredOrFunc,
Modes, WithInst, MaybeDetism, InstVarSet, dummy_context),
ModeDecl = class_decl_mode(ModeInfo),
ModeDecls = [ModeDecl]
else
TypesWithoutModes = TypesAndModes,
ModeDecls = []
),
varset.init(EmptyInstVarSet),
PredOrFuncInfo = class_pred_or_func_info(SymName, PredOrFunc,
TypesWithoutModes, WithType, no, no, TypeVarSet, EmptyInstVarSet,
ExistQVars, Purity, Constraints, dummy_context),
PredOrFuncDecl = class_decl_pred_or_func(PredOrFuncInfo),
Decls = [PredOrFuncDecl | ModeDecls]
;
Decl0 = class_decl_mode(ModeInfo0),
ModeInfo0 = class_mode_info(SymName, MaybePredOrFunc,
Modes, WithInst, MaybeDetism, InstVarSet, _Context),
ModeInfo = class_mode_info(SymName, MaybePredOrFunc,
Modes, WithInst, MaybeDetism, InstVarSet, dummy_context),
Decl = class_decl_mode(ModeInfo),
Decls = [Decl]
).
%---------------------%
:- pred gather_in_instance(module_section::in, item_instance_info::in,
gathered_item_multi_map_in::in, gathered_item_multi_map_in::out) is det.
gather_in_instance(Section, ItemInstance, !InstanceMap) :-
ItemInstance = item_instance_info(ClassName, ClassParams,
_, _, _, _, _, _, _),
Item = item_instance(ItemInstance),
ClassNA = recomp_item_name(ClassName, list.length(ClassParams)),
multi_map.add(ClassNA, Section - Item, !InstanceMap).
%---------------------%
:- pred gather_in_decl_pragma(module_section::in, item_decl_pragma_info::in,
cord(decl_pragma_record)::in, cord(decl_pragma_record)::out) is det.
gather_in_decl_pragma(Section, ItemDeclPragma, !DeclPragmas) :-
ItemDeclPragma = item_pragma_info(DeclPragma, _, _),
gather_decl_pragma_for_what_pf_id(DeclPragma, MaybePredOrFuncId),
(
MaybePredOrFuncId = yes(PredOrFuncId),
Item = item_decl_pragma(ItemDeclPragma),
Record = decl_pragma_record(Section, PredOrFuncId, Item),
cord.snoc(Record, !DeclPragmas)
;
MaybePredOrFuncId = no
% XXX Not doing anything here is probably a bug.
).
%---------------------%
:- pred gather_in_type_repn(module_section::in, item_type_repn_info::in,
gathered_item_multi_map_na::in, gathered_item_multi_map_na::out) is det.
gather_in_type_repn(Section, ItemTypeRepn, !TypeDefnMap) :-
ItemTypeRepn = item_type_repn_info(SymName, Params, _, _, _, _),
Item = item_type_repn(ItemTypeRepn),
TypeCtorNA = name_arity(unqualify_name(SymName), list.length(Params)),
% XXX We used to add these to the mivn_type_defns map.
multi_map.add(TypeCtorNA, Section - Item, !TypeDefnMap).
%---------------------------------------------------------------------------%
:- pred apply_decl_pragma_record(decl_pragma_record::in,
gathered_item_multi_map_na::in, gathered_item_multi_map_na::out,
gathered_item_multi_map_na::in, gathered_item_multi_map_na::out,
gathered_item_multi_map_na::in, gathered_item_multi_map_na::out) is det.
apply_decl_pragma_record(DeclPragma, !PredMap, !FuncMap, !TypeClassMap) :-
DeclPragma = decl_pragma_record(Section, ItemId, Item),
ItemId = MaybePredOrFunc - sym_name_arity(SymName, Arity),
% For predicates defined using `with_type` annotations we don't know
% the actual arity, so always we need to add entries for pragmas, even if
% the pragma doesn't match any recorded predicate. For pragmas which don't
% include enough information to work out whether they apply to a predicate
% or a function, this will result in an extra entry in the version numbers.
% Pragmas in the interface aren't common so this won't be too much of
% a problem.
NameArity = name_arity(unqualify_name(SymName), Arity),
(
MaybePredOrFunc = yes(PredOrFunc),
(
PredOrFunc = pf_predicate,
multi_map.add(NameArity, Section - Item, !PredMap)
;
PredOrFunc = pf_function,
multi_map.add(NameArity, Section - Item, !FuncMap)
)
;
MaybePredOrFunc = no,
multi_map.add(NameArity, Section - Item, !PredMap),
multi_map.add(NameArity, Section - Item, !FuncMap)
),
% Pragmas can apply to typeclass methods.
% XXX I (zs) do not see why a decl_pragma *outside* a typeclass
% declaration should be able to apply to a class method that is declared
% *inside* the typeclass declaration. We should require that any
% decl pragma that is intended to apply to a class method
% should be declared next to it *inside the typeclass declaration itself*.
map.map_values_only(
distribute_pragma_items_class_items(MaybePredOrFunc,
SymName, Arity, Item, Section),
!TypeClassMap).
:- pred distribute_pragma_items_class_items(maybe(pred_or_func)::in,
sym_name::in, arity::in, item::in, module_section::in,
assoc_list(module_section, item)::in,
assoc_list(module_section, item)::out) is det.
distribute_pragma_items_class_items(MaybePredOrFunc, SymName, Arity,
Item, Section, !ClassItems) :-
( if
% Does this pragma match any of the methods of this class.
list.member(_ - ClassItem, !.ClassItems),
ClassItem = item_typeclass(ClassItemTypeClass),
ClassItemTypeClass ^ tc_class_methods =
class_interface_concrete(Decls),
list.member(Decl, Decls),
Decl = class_decl_pred_or_func(PredOrFuncInfo),
PredOrFuncInfo = class_pred_or_func_info(SymName, MethodPredOrFunc,
TypesAndModes, WithType, _, _, _, _, _, _, _, _),
( MaybePredOrFunc = yes(MethodPredOrFunc)
; MaybePredOrFunc = no
),
(
WithType = no,
adjust_func_arity(MethodPredOrFunc, Arity,
list.length(TypesAndModes))
;
WithType = yes(_)
% We don't know the actual arity, so just match on the name
% and pred_or_func.
)
then
% XXX O(N^2), but shouldn't happen too often.
!:ClassItems = !.ClassItems ++ [Section - Item]
else
true
).
%---------------------------------------------------------------------------%
:- type maybe_pred_or_func_id == pair(maybe(pred_or_func), sym_name_arity).
:- pred gather_decl_pragma_for_what_pf_id(decl_pragma::in,
maybe(maybe_pred_or_func_id)::out) is det.
gather_decl_pragma_for_what_pf_id(DeclPragma, MaybePredOrFuncId) :-
(
DeclPragma = decl_pragma_type_spec(TypeSpecInfo),
TypeSpecInfo = pragma_info_type_spec(PFUMM, Name, _, _, _, _),
pfumm_to_maybe_pf_arity_maybe_modes(PFUMM, MaybePredOrFunc,
user_arity(Arity), _MaybeModes),
MaybePredOrFuncId = yes(MaybePredOrFunc - sym_name_arity(Name, Arity))
;
DeclPragma = decl_pragma_obsolete_proc(ObsoleteProcInfo),
ObsoleteProcInfo = pragma_info_obsolete_proc(PredNameModesPF, _),
PredNameModesPF = proc_pf_name_modes(PredOrFunc, Name, Modes),
adjust_func_arity(PredOrFunc, Arity, list.length(Modes)),
MaybePredOrFuncId = yes(yes(PredOrFunc) - sym_name_arity(Name, Arity))
;
DeclPragma = decl_pragma_obsolete_pred(ObsoletePredInfo),
ObsoletePredInfo = pragma_info_obsolete_pred(PredNameArity, _),
PredNameArity = pred_pfu_name_arity(PFU, Name, user_arity(Arity)),
MaybePredOrFunc = pfu_to_maybe_pred_or_func(PFU),
MaybePredOrFuncId = yes(MaybePredOrFunc - sym_name_arity(Name, Arity))
;
DeclPragma = decl_pragma_format_call(FormatCallInfo),
FormatCallInfo = pragma_info_format_call(PredNameArity, _),
PredNameArity = pred_pf_name_arity(PF, Name, user_arity(Arity)),
MaybePredOrFuncId = yes(yes(PF) - sym_name_arity(Name, Arity))
;
DeclPragma = decl_pragma_oisu(_),
% XXX Unlike all the other decl_pragmas, the oisu (order-independent
% state update) pragma is about a type, not a predicate or function.
%
% We don't have to handle it here, because it is not yet implemented.
% When it *is* implemented, we will need to tell our caller to record
% this pragma for the type_ctor named in the pragma.
MaybePredOrFuncId = no
;
( DeclPragma = decl_pragma_terminates(PredNameArity)
; DeclPragma = decl_pragma_does_not_terminate(PredNameArity)
; DeclPragma = decl_pragma_check_termination(PredNameArity)
),
PredNameArity = pred_pfu_name_arity(PFU, Name, user_arity(Arity)),
MaybePredOrFunc = pfu_to_maybe_pred_or_func(PFU),
MaybePredOrFuncId = yes(MaybePredOrFunc - sym_name_arity(Name, Arity))
;
(
DeclPragma = decl_pragma_termination_info(TermInfo),
TermInfo = pragma_info_termination_info(PredNameModesPF, _, _)
;
DeclPragma = decl_pragma_termination2_info(Term2Info),
Term2Info = pragma_info_termination2_info(PredNameModesPF, _, _, _)
;
DeclPragma = decl_pragma_structure_sharing(SharingInfo),
SharingInfo = pragma_info_structure_sharing(PredNameModesPF,
_, _, _, _, _)
;
DeclPragma = decl_pragma_structure_reuse(ReuseInfo),
ReuseInfo = pragma_info_structure_reuse(PredNameModesPF,
_, _, _, _, _)
),
PredNameModesPF = proc_pf_name_modes(PredOrFunc, Name, Modes),
adjust_func_arity(PredOrFunc, Arity, list.length(Modes)),
MaybePredOrFuncId = yes(yes(PredOrFunc) - sym_name_arity(Name, Arity))
).
%---------------------------------------------------------------------------%
%
% Check whether various things are unchanged.
%
% XXX This code is a bit brittle, because in some places the things being
% compared include term.contexts, which can change even if nothing we care
% about has been modified. For example, it won't work for clauses, which
% have lots of contexts inside them.
%
% However, the important thing is that these predicates will never succeed
% when they shouldn't, so they should never cause a necessary recompilation
% to be missed.
%
% XXX This predicate is unused, which is likely to be a bug.
%
:- pred is_item_include_changed(item_include::in, item_include::in,
maybe_changed::out) is det.
:- pragma consider_used(pred(is_item_include_changed/3)).
is_item_include_changed(ItemInclude1, ItemInclude2, Changed) :-
ItemInclude1 = item_include(ModuleName1, _, _),
ItemInclude2 = item_include(ModuleName2, _, _),
( if ModuleName1 = ModuleName2 then
Changed = unchanged
else
Changed = changed
).
% XXX This predicate is unused, which is likely to be a bug.
%
:- pred is_item_avail_changed(item_avail::in, item_avail::in,
maybe_changed::out) is det.
:- pragma consider_used(pred(is_item_avail_changed/3)).
is_item_avail_changed(Avail1, Avail2, Changed) :-
(
Avail1 = avail_import(avail_import_info(ModuleName1, _, _)),
( if
Avail2 = avail_import(avail_import_info(ModuleName2, _, _)),
ModuleName1 = ModuleName2
then
Changed = unchanged
else
Changed = changed
)
;
Avail1 = avail_use(avail_use_info(ModuleName1, _, _)),
( if
Avail2 = avail_use(avail_use_info(ModuleName2, _, _)),
ModuleName1 = ModuleName2
then
Changed = unchanged
else
Changed = changed
)
).
:- pred are_items_changed(assoc_list(module_section, item)::in,
assoc_list(module_section, item)::in, maybe_changed::out) is det.
are_items_changed([], [], unchanged).
are_items_changed([], [_ | _], changed).
are_items_changed([_ | _], [], changed).
are_items_changed([Section1 - Item1 | Items1], [Section2 - Item2 | Items2],
Changed) :-
( if Section1 = Section2 then
is_item_changed(Item1, Item2, ItemChanged),
(
ItemChanged = changed,
Changed = changed
;
ItemChanged = unchanged,
are_items_changed(Items1, Items2, Changed)
)
else
Changed = changed
).
% In most places here, we don't need to compare the varsets.
% What matters is that the variable numbers in the arguments
% and body are the same, the names are usually irrelevant.
%
% The only places where the names of variables affect the compilation
% of the program are in explicit type qualifications and
% `:- pragma type_spec' declarations. Explicit type qualifications
% do not need to be considered here. This module only deals with items
% in interface files (we don't yet write type qualifications to `.opt'
% files). Variables in type qualifications are only matched with
% the head type variables of the predicate by make_hlds.m.
% For `:- pragma type_spec' declarations to work we need to consider
% a predicate or function declaration to be changed if the names
% of any of the type variables are changed.
%
% It is important not to compare the varsets for type and instance
% declarations because the declarations we get here may be abstract
% declarations produced from concrete declarations for use in an
% interface file. The varsets may contain variables from the discarded
% bodies which will not be present in the items read in from the
% interface files for comparison.
%
% This code assumes that the variables in the head of a type or instance
% declaration are added to the varset before those from the body, so that
% the variable numbers in the head of the declaration match those from
% an abstract declaration read from an interface file.
%
:- pred is_item_changed(item::in, item::in, maybe_changed::out) is det.
is_item_changed(Item1, Item2, Changed) :-
(
Item1 = item_clause(ItemClause1),
ItemClause1 = item_clause_info(PorF, SymName, Args, _, Goal, _, _),
% XXX Need to compare the goals properly in clauses and assertions.
% That is not necessary at the moment because smart recompilation
% doesn't work with inter-module optimization yet.
( if
Item2 = item_clause(ItemClause2),
ItemClause2 = item_clause_info(PorF, SymName, Args, _, Goal, _, _)
then
Changed = unchanged
else
Changed = changed
)
;
Item1 = item_type_defn(ItemTypeDefn1),
ItemTypeDefn1 = item_type_defn_info(_, Name, Args, Defn, _, _),
( if
Item2 = item_type_defn(ItemTypeDefn2),
ItemTypeDefn2 = item_type_defn_info(_, Name, Args, Defn, _, _)
then
Changed = unchanged
else
Changed = changed
)
;
Item1 = item_inst_defn(ItemInstDefn1),
ItemInstDefn1 = item_inst_defn_info(_, Name, Args,
MaybeForTypeCtor, Defn, _, _),
( if
Item2 = item_inst_defn(ItemInstDefn2),
ItemInstDefn2 = item_inst_defn_info(_, Name, Args,
MaybeForTypeCtor, Defn, _, _)
then
Changed = unchanged
else
Changed = changed
)
;
Item1 = item_mode_defn(ItemModeDefn1),
ItemModeDefn1 = item_mode_defn_info(_, Name, Args, Defn, _, _),
( if
Item2 = item_mode_defn(ItemModeDefn2),
ItemModeDefn2 = item_mode_defn_info(_, Name, Args, Defn, _, _)
then
Changed = unchanged
else
Changed = changed
)
;
Item1 = item_pred_decl(ItemPredDecl1),
ItemPredDecl1 = item_pred_decl_info(Name, PredOrFunc,
TypesAndModes1, WithType1, _, Det1, _, TVarSet1, _,
ExistQVars1, Purity, Constraints1, _, _),
( if
Item2 = item_pred_decl(ItemPredDecl2),
ItemPredDecl2 = item_pred_decl_info(Name, PredOrFunc,
TypesAndModes2, WithType2, _, Det2, _, TVarSet2, _,
ExistQVars2, Purity, Constraints2, _, _),
% For predicates, ignore the determinism -- the modes and
% determinism should have been split into a separate declaration.
% This case can only happen if this was not a combined predicate
% and mode declaration (XXX We should warn about this somewhere).
% For functions a determinism declaration but no modes implies
% the default modes. The default modes are added later by
% make_hlds.m, so they won't have been split into a separate
% declaration here.
(
PredOrFunc = pf_function,
Det1 = Det2
;
PredOrFunc = pf_predicate
),
pred_or_func_type_is_unchanged(TVarSet1, ExistQVars1,
TypesAndModes1, WithType1, Constraints1, TVarSet2,
ExistQVars2, TypesAndModes2, WithType2, Constraints2)
then
Changed = unchanged
else
Changed = changed
)
;
Item1 = item_mode_decl(ItemModeDecl1),
ItemModeDecl1 = item_mode_decl_info(Name, PredOrFunc, Modes1,
WithInst1, Det, InstVarSet1, _, _),
( if
Item2 = item_mode_decl(ItemModeDecl2),
ItemModeDecl2 = item_mode_decl_info(Name, PredOrFunc, Modes2,
WithInst2, Det, InstVarSet2, _, _),
pred_or_func_mode_is_unchanged(InstVarSet1, Modes1, WithInst1,
InstVarSet2, Modes2, WithInst2)
then
Changed = unchanged
else
Changed = changed
)
;
Item1 = item_foreign_enum(ItemForeignEnum1),
ItemForeignEnum1 =
item_foreign_enum_info(Lang, TypeCtor, Values, _, _),
( if
Item2 = item_foreign_enum(ItemForeignEnum2),
ItemForeignEnum2 = item_foreign_enum_info(Lang, TypeCtor, Values,
_, _)
then
Changed = unchanged
else
Changed = changed
)
;
Item1 = item_foreign_export_enum(ItemForeignEnum1),
ItemForeignEnum1 = item_foreign_export_enum_info(Lang,
TypeCtor, Attrs, Overrides, _, _),
( if
Item2 = item_foreign_export_enum(ItemForeignEnum2),
ItemForeignEnum2 = item_foreign_export_enum_info(Lang,
TypeCtor, Attrs, Overrides, _, _)
then
Changed = unchanged
else
Changed = changed
)
;
Item1 = item_decl_pragma(ItemDeclPragma1),
ItemDeclPragma1 = item_pragma_info(DeclPragma1, _, _),
% We do need to compare the variable names in `:- pragma type_spec'
% declarations because the names of the variables are used to find
% the corresponding variables in the predicate or function
% type declaration.
( if
Item2 = item_decl_pragma(ItemDeclPragma2),
ItemDeclPragma2 = item_pragma_info(DeclPragma2, _, _)
then
( if
DeclPragma1 = decl_pragma_type_spec(TypeSpecInfo1),
DeclPragma2 = decl_pragma_type_spec(TypeSpecInfo2),
TypeSpecInfo1 = pragma_info_type_spec(PFUMM, Name, SpecName,
TypeSubst1, TVarSet1, _),
TypeSpecInfo2 = pragma_info_type_spec(PFUMM, Name, SpecName,
TypeSubst2, TVarSet2, _)
then
assoc_list.keys_and_values(one_or_more_to_list(TypeSubst1),
TVars1, Types1),
assoc_list.keys_and_values(one_or_more_to_list(TypeSubst2),
TVars2, Types2),
% XXX kind inference:
% we assume vars have kind `star'.
KindMap = map.init,
prog_type.var_list_to_type_list(KindMap, TVars1, TVarTypes1),
prog_type.var_list_to_type_list(KindMap, TVars2, TVarTypes2),
( if
type_list_is_unchanged(
TVarSet1, TVarTypes1 ++ Types1,
TVarSet2, TVarTypes2 ++ Types2,
_, _, _)
then
Changed = unchanged
else
Changed = changed
)
else
( if DeclPragma1 = DeclPragma2 then
Changed = unchanged
else
Changed = changed
)
)
else
Changed = changed
)
;
Item1 = item_impl_pragma(ItemImplPragma1),
ItemImplPragma1 = item_pragma_info(ImplPragma, _, _),
( if
Item2 = item_impl_pragma(ItemImplPragma2),
ItemImplPragma2 = item_pragma_info(ImplPragma, _, _)
then
Changed = unchanged
else
Changed = changed
)
;
Item1 = item_generated_pragma(ItemGenPragma1),
ItemGenPragma1 = item_pragma_info(GenPragma, _, _),
( if
Item2 = item_generated_pragma(ItemGenPragma2),
ItemGenPragma2 = item_pragma_info(GenPragma, _, _)
then
Changed = unchanged
else
Changed = changed
)
;
Item1 = item_promise(ItemPromiseInfo1),
ItemPromiseInfo1 = item_promise_info(PromiseType, Goal, _,
UnivVars, _, _),
( if
Item2 = item_promise(ItemPromiseInfo2),
ItemPromiseInfo2 = item_promise_info(PromiseType, Goal, _,
UnivVars, _, _)
then
Changed = unchanged
else
Changed = changed
)
;
Item1 = item_initialise(ItemInitialise1),
ItemInitialise1 = item_initialise_info(A, B, C, _, _),
( if
Item2 = item_initialise(ItemInitialise2),
ItemInitialise2 = item_initialise_info(A, B, C, _, _)
then
Changed = unchanged
else
Changed = changed
)
;
Item1 = item_finalise(ItemFinalise1),
ItemFinalise1 = item_finalise_info(A, B, C, _, _),
( if
Item2 = item_finalise(ItemFinalise2),
ItemFinalise2 = item_finalise_info(A, B, C, _, _)
then
Changed = unchanged
else
Changed = changed
)
;
Item1 = item_mutable(ItemMutable1),
ItemMutable1 = item_mutable_info(A, _, B, _, C, D, E, F, _, _),
( if
Item2 = item_mutable(ItemMutable2),
ItemMutable2 = item_mutable_info(A, _, B, _, C, D, E, F, _, _)
then
Changed = unchanged
else
Changed = changed
)
;
Item1 = item_typeclass(ItemTypeClass1),
ItemTypeClass1 = item_typeclass_info(Constraints, FunDeps, Name,
Vars, Interface1, _, _, _),
( if
Item2 = item_typeclass(ItemTypeClass2),
ItemTypeClass2 = item_typeclass_info(Constraints, FunDeps, Name,
Vars, Interface2, _, _, _),
class_interface_is_unchanged(Interface1, Interface2)
then
Changed = unchanged
else
Changed = changed
)
;
Item1 = item_instance(ItemInstance1),
ItemInstance1 = item_instance_info(Constraints, Name,
Types, OriginalTypes, Body, _, Module, _, _),
( if
Item2 = item_instance(ItemInstance2),
ItemInstance2 = item_instance_info(Constraints, Name,
Types, OriginalTypes, Body, _, Module, _, _)
then
Changed = unchanged
else
Changed = changed
)
;
Item1 = item_type_repn(_),
% Type representation items record information derived from
% *other items*. They cannot change unless those other items change.
Changed = unchanged
).
% Apply a substitution to the existq_tvars, types_and_modes, and
% prog_constraints so that the type variables from both declarations
% being checked are contained in the same tvarset, then check that
% they are identical.
%
% We can't just assume that the varsets will be identical for
% identical declarations because parse_tree_out_misc.m splits
% combined type and mode declarations into separate declarations.
% When they are read back in, the variable numbers will be different,
% because the parser stores the type and inst variables for a combined
% declaration in a single varset (it doesn't know which are which).
%
:- pred pred_or_func_type_is_unchanged(tvarset::in, existq_tvars::in,
list(type_and_mode)::in, maybe(mer_type)::in, prog_constraints::in,
tvarset::in, existq_tvars::in, list(type_and_mode)::in,
maybe(mer_type)::in, prog_constraints::in) is semidet.
pred_or_func_type_is_unchanged(TVarSet1, ExistQVars1, TypesAndModes1,
MaybeWithType1, Constraints1, TVarSet2, ExistQVars2,
TypesAndModes2, MaybeWithType2, Constraints2) :-
GetArgTypes =
( func(TypeAndMode0) = Type :-
(
TypeAndMode0 = type_only(Type)
;
% This should have been split out into a separate
% mode declaration by gather_items.
TypeAndMode0 = type_and_mode(_, _),
unexpected($pred, "type_and_mode")
)
),
Types1 = list.map(GetArgTypes, TypesAndModes1),
Types2 = list.map(GetArgTypes, TypesAndModes2),
(
MaybeWithType1 = yes(WithType1),
MaybeWithType2 = yes(WithType2),
AllTypes1 = [WithType1 | Types1],
AllTypes2 = [WithType2 | Types2]
;
MaybeWithType1 = no,
MaybeWithType2 = no,
AllTypes1 = Types1,
AllTypes2 = Types2
),
type_list_is_unchanged(TVarSet1, AllTypes1, TVarSet2, AllTypes2,
_TVarSet, Renaming, Types2ToTypes1Subst),
% Check that the existentially quantified variables are equivalent.
%
% XXX kind inference: we assume all tvars have kind `star'.
map.init(KindMap2),
apply_variable_renaming_to_tvar_kind_map(Renaming, KindMap2,
RenamedKindMap2),
apply_variable_renaming_to_tvar_list(Renaming, ExistQVars2,
RenamedExistQVars2),
apply_rec_subst_to_tvar_list(RenamedKindMap2, Types2ToTypes1Subst,
RenamedExistQVars2, SubstExistQTypes2),
( if
prog_type.type_list_to_var_list(SubstExistQTypes2, SubstExistQVars2)
then
ExistQVars1 = SubstExistQVars2
else
unexpected($pred, "non-var")
),
% Check that the class constraints are identical.
apply_variable_renaming_to_prog_constraints(Renaming,
Constraints2, RenamedConstraints2),
apply_rec_subst_to_prog_constraints(Types2ToTypes1Subst,
RenamedConstraints2, SubstConstraints2),
Constraints1 = SubstConstraints2.
:- pred type_list_is_unchanged(tvarset::in, list(mer_type)::in,
tvarset::in, list(mer_type)::in, tvarset::out,
tvar_renaming::out, tsubst::out) is semidet.
type_list_is_unchanged(TVarSet1, Types1, TVarSet2, Types2,
TVarSet, Renaming, Types2ToTypes1Subst) :-
tvarset_merge_renaming(TVarSet1, TVarSet2, TVarSet, Renaming),
apply_variable_renaming_to_type_list(Renaming, Types2, SubstTypes2),
% Check that the types are equivalent.
type_list_subsumes(SubstTypes2, Types1, Types2ToTypes1Subst),
type_list_subsumes(Types1, SubstTypes2, _),
% Check that the corresponding variables have the same names. This is
% necessary because `:- pragma type_spec' declarations depend on the names
% of the variables, so for example if two variable names are swapped,
% the same `:- pragma type_spec' declaration will cause a different
% specialized version to be created.
( all [VarInItem1, VarInItem2]
(
map.member(Types2ToTypes1Subst, VarInItem2, SubstTerm),
% Note that since the type comes from a substitution,
% it will not contain a kind annotation.
SubstTerm = type_variable(VarInItem1, _)
)
=>
(
varset.lookup_name(TVarSet, VarInItem1, VarName1),
varset.lookup_name(TVarSet, VarInItem2, VarName2),
(
VarName1 = VarName2
;
% Variables written to interface files are always named,
% even if the variable in the source code was not, so we can't
% just use varset.search_name to check whether the variables
% are named.
VarIsNotNamed =
( pred(VarName::in) is semidet :-
string.append("V_", VarNum, VarName),
string.to_int(VarNum, _)
),
VarIsNotNamed(VarName1),
VarIsNotNamed(VarName2)
)
)
).
:- pred pred_or_func_mode_is_unchanged(inst_varset::in, list(mer_mode)::in,
maybe(mer_inst)::in, inst_varset::in, list(mer_mode)::in,
maybe(mer_inst)::in) is semidet.
pred_or_func_mode_is_unchanged(InstVarSet1, Modes1, MaybeWithInst1,
InstVarSet2, Modes2, MaybeWithInst2) :-
varset.coerce(InstVarSet1, VarSet1),
varset.coerce(InstVarSet2, VarSet2),
% Apply the substitution to the modes so that the inst variables
% from both declarations being checked are contained in the same
% inst_varset, then check that they are identical.
varset.merge_renaming(VarSet1, VarSet2, _, InstRenaming),
% Treat modes as terms here to use first_term_list_subsumes_second,
% which does just what we want here.
ModeTerms1 = list.map(mode_to_term(output_mercury), Modes1),
ModeTerms2 = list.map(mode_to_term(output_mercury), Modes2),
(
MaybeWithInst1 = yes(Inst1),
MaybeWithInst2 = yes(Inst2),
WithInstTerm1 = mode_to_term(output_mercury,
from_to_mode(free, Inst1)),
WithInstTerm2 = mode_to_term(output_mercury,
from_to_mode(free, Inst2)),
AllModeTerms1 = [WithInstTerm1 | ModeTerms1],
AllModeTerms2 = [WithInstTerm2 | ModeTerms2]
;
MaybeWithInst1 = no,
MaybeWithInst2 = no,
AllModeTerms1 = ModeTerms1,
AllModeTerms2 = ModeTerms2
),
term_subst.apply_renaming_in_terms(InstRenaming,
AllModeTerms2, SubstAllModeTerms2),
first_term_list_subsumes_second(AllModeTerms1, SubstAllModeTerms2, _),
first_term_list_subsumes_second(SubstAllModeTerms2, AllModeTerms1, _).
% Combined typeclass method type and mode declarations are split as for
% ordinary predicate declarations, so the varsets won't necessarily match
% up if a typeclass declaration is read back from an interface file.
%
:- pred class_interface_is_unchanged(class_interface::in, class_interface::in)
is semidet.
class_interface_is_unchanged(Interface0, Interface) :-
(
Interface0 = class_interface_abstract,
Interface = class_interface_abstract
;
Interface0 = class_interface_concrete(Methods1),
class_methods_are_unchanged(Methods1, Methods2),
Interface = class_interface_concrete(Methods2)
).
:- pred class_methods_are_unchanged(list(class_decl)::in, list(class_decl)::in)
is semidet.
class_methods_are_unchanged([], []).
class_methods_are_unchanged([Decl1 | Decls1], [Decl2 | Decls2]) :-
(
Decl1 = class_decl_pred_or_func(PredOrFuncInfo1),
Decl2 = class_decl_pred_or_func(PredOrFuncInfo2),
PredOrFuncInfo1 = class_pred_or_func_info(Name, PredOrFunc,
TypesAndModes1, WithType1, _, Detism, TVarSet1, _, ExistQVars1,
Purity, Constraints1, _),
PredOrFuncInfo2 = class_pred_or_func_info(Name, PredOrFunc,
TypesAndModes2, WithType2, _, Detism, TVarSet2, _, ExistQVars2,
Purity, Constraints2, _),
pred_or_func_type_is_unchanged(TVarSet1, ExistQVars1,
TypesAndModes1, WithType1, Constraints1,
TVarSet2, ExistQVars2,
TypesAndModes2, WithType2, Constraints2)
;
Decl1 = class_decl_mode(ModeInfo1),
Decl2 = class_decl_mode(ModeInfo2),
ModeInfo1 = class_mode_info(Name, PredOrFunc, Modes1,
WithInst1, Det, InstVarSet1, _),
ModeInfo2 = class_mode_info(Name, PredOrFunc, Modes2,
WithInst2, Det, InstVarSet2, _),
pred_or_func_mode_is_unchanged(InstVarSet1, Modes1, WithInst1,
InstVarSet2, Modes2, WithInst2)
),
class_methods_are_unchanged(Decls1, Decls2).
%---------------------------------------------------------------------------%
module_item_version_numbers_to_string(ModuleItemVersionNumbers) = Str :-
ModuleItemVersionNumbers =
module_item_version_numbers(TypeNameMap, TypeDefnMap,
InstMap, ModeMap, ClassMap, InstanceMap, PredMap, FuncMap),
ItemTypeMaybeStrs = [
item_type_and_versions_to_string_na(recomp_type_name, TypeNameMap),
item_type_and_versions_to_string_na(recomp_type_defn, TypeDefnMap),
item_type_and_versions_to_string_na(recomp_inst, InstMap),
item_type_and_versions_to_string_na(recomp_mode, ModeMap),
item_type_and_versions_to_string_na(recomp_predicate, PredMap),
item_type_and_versions_to_string_na(recomp_function, FuncMap),
item_type_and_versions_to_string_na(recomp_typeclass, ClassMap),
item_type_and_versions_to_string_in("instance", InstanceMap)
],
list.filter_map(maybe_is_yes, ItemTypeMaybeStrs, ItemTypeStrs),
ItemTypesStr = string.join_list(",\n", ItemTypeStrs),
string.format("{\n%s\n}", [s(ItemTypesStr)], Str).
%---------------------%
:- func item_type_and_versions_to_string_na(recomp_item_type,
map(name_arity, version_number)) = maybe(string).
item_type_and_versions_to_string_na(ItemType, VersionMap) = MaybeStr :-
( if map.is_empty(VersionMap) then
MaybeStr = no
else
string_to_recomp_item_type(ItemTypeStr, ItemType),
map.to_assoc_list(VersionMap, VersionsAL),
ItemVersionStrs =
list.map(name_arity_version_number_to_string, VersionsAL),
ItemVersionsStr = string.join_list(",\n", ItemVersionStrs),
string.format("\t%s(\n%s\n\t)",
[s(ItemTypeStr), s(ItemVersionsStr)], Str),
MaybeStr = yes(Str)
).
:- func item_type_and_versions_to_string_in(string,
map(recomp_item_name, version_number)) = maybe(string).
item_type_and_versions_to_string_in(ItemTypeStr, VersionMap) = MaybeStr :-
( if map.is_empty(VersionMap) then
MaybeStr = no
else
map.to_assoc_list(VersionMap, VersionsAL),
ItemVersionStrs =
list.map(recomp_item_name_version_number_to_string, VersionsAL),
ItemVersionsStr = string.join_list(",\n", ItemVersionStrs),
string.format("%s(\n%s\n\t)",
[s(ItemTypeStr), s(ItemVersionsStr)], Str),
MaybeStr = yes(Str)
).
%---------------------%
:- func name_arity_version_number_to_string(pair(name_arity, version_number))
= string.
name_arity_version_number_to_string(NameArity - VersionNumber) = Str :-
NameArity = name_arity(Name, Arity),
SymNameStr = mercury_bracketed_sym_name_to_string_ngt(
next_to_graphic_token, unqualified(Name)),
VersionNumberStr = version_number_to_string(VersionNumber),
string.format("\t\t%s/%i - %s",
[s(SymNameStr), i(Arity), s(VersionNumberStr)], Str).
:- func recomp_item_name_version_number_to_string(
pair(recomp_item_name, version_number)) = string.
recomp_item_name_version_number_to_string(ItemName - VersionNumber) = Str :-
ItemName = recomp_item_name(SymName, Arity),
SymNameStr = mercury_bracketed_sym_name_to_string_ngt(
next_to_graphic_token, SymName),
VersionNumberStr = version_number_to_string(VersionNumber),
string.format("%s/%i - %s",
[s(SymNameStr), i(Arity), s(VersionNumberStr)], Str).
%---------------------------------------------------------------------------%
module_item_version_numbers_version_number = 1.
%---------------------------------------------------------------------------%
parse_module_item_version_numbers(VersionNumbersTerm, Result) :-
( if
VersionNumbersTerm = term.functor(term.atom("{}"),
VersionNumbersTermList0, _)
then
VersionNumbersTermList = VersionNumbersTermList0
else
VersionNumbersTermList = [VersionNumbersTerm]
),
map_parser(parse_item_type_version_numbers, VersionNumbersTermList,
Result0),
(
Result0 = ok1(NamedFields),
% NOTE This update could be done by parse_item_type_version_numbers.
UpdateNamedField =
( pred(VNResult::in, VNs0::in, VNs::out) is det :-
(
VNResult = items(ItemType, ItemVNs),
(
ItemType = recomp_type_name,
VNs = VNs0 ^ mivn_type_names := ItemVNs
;
ItemType = recomp_type_defn,
VNs = VNs0 ^ mivn_type_defns := ItemVNs
;
ItemType = recomp_inst,
VNs = VNs0 ^ mivn_insts := ItemVNs
;
ItemType = recomp_mode,
VNs = VNs0 ^ mivn_modes := ItemVNs
;
ItemType = recomp_typeclass,
VNs = VNs0 ^ mivn_typeclasses := ItemVNs
;
ItemType = recomp_functor,
unexpected($pred, "recomp_functor")
;
ItemType = recomp_predicate,
VNs = VNs0 ^ mivn_predicates := ItemVNs
;
ItemType = recomp_function,
VNs = VNs0 ^ mivn_functions := ItemVNs
;
ItemType = recomp_mutable,
unexpected($pred, "recomp_mutable")
;
ItemType = recomp_foreign_proc,
unexpected($pred, "recomp_foreign_proc")
)
;
VNResult = instances(InstancesVNs),
VNs = VNs0 ^ mivn_instances := InstancesVNs
)
),
ModuleItemVersionNumbers0 = init_module_item_version_numbers,
list.foldl(UpdateNamedField, NamedFields,
ModuleItemVersionNumbers0, ModuleItemVersionNumbers),
Result = ok1(ModuleItemVersionNumbers)
;
Result0 = error1(Errors),
Result = error1(Errors)
).
:- type item_version_numbers_result
---> items(recomp_item_type, name_arity_version_map)
; instances(recomp_item_name_version_map).
:- pred parse_item_type_version_numbers(term::in,
maybe1(item_version_numbers_result)::out) is det.
parse_item_type_version_numbers(Term, Result) :-
( if
Term = term.functor(term.atom(ItemTypeStr), ItemsVNsTerms, _),
string_to_recomp_item_type(ItemTypeStr, ItemType)
then
ParseName =
( pred(NameTerm::in, Name::out) is semidet :-
NameTerm = term.functor(term.atom(Name), [], _)
),
map_parser(parse_key_version_number(ParseName), ItemsVNsTerms,
Result0),
(
Result0 = ok1(VNsAL),
map.from_assoc_list(VNsAL, VNsMap),
Result = ok1(items(ItemType, VNsMap))
;
Result0 = error1(Specs),
Result = error1(Specs)
)
else if
Term = term.functor(term.atom("instance"), InstanceVNsTerms, _)
then
map_parser(parse_item_version_number(try_parse_sym_name_and_no_args),
InstanceVNsTerms, Result1),
(
Result1 = ok1(VNsAL),
map.from_assoc_list(VNsAL, VNsMap),
Result = ok1(instances(VNsMap))
;
Result1 = error1(Specs),
Result = error1(Specs)
)
else
% XXX This is an uninformative error message.
Pieces = [words("Invalid item type version numbers."), nl],
Spec = simplest_spec($pred, severity_error, phase_term_to_parse_tree,
get_term_context(Term), Pieces),
Result = error1([Spec])
).
:- pred parse_key_version_number(
pred(term, string)::(pred(in, out) is semidet), term::in,
maybe1(pair(name_arity, version_number))::out) is det.
parse_key_version_number(ParseName, Term, Result) :-
( if
Term = term.functor(term.atom("-"),
[ItemNameArityTerm, VersionNumberTerm], _),
ItemNameArityTerm = term.functor(term.atom("/"),
[NameTerm, ArityTerm], _),
ParseName(NameTerm, Name),
term_int.decimal_term_to_int(ArityTerm, Arity),
parse_version_number_term(VersionNumberTerm, VersionNumber)
then
Result = ok1(name_arity(Name, Arity) - VersionNumber)
else
Pieces = [words("Error in item version number."), nl],
Spec = simplest_spec($pred, severity_error, phase_term_to_parse_tree,
get_term_context(Term), Pieces),
Result = error1([Spec])
).
:- pred parse_item_version_number(
pred(term, sym_name)::(pred(in, out) is semidet), term::in,
maybe1(pair(recomp_item_name, version_number))::out) is det.
parse_item_version_number(ParseName, Term, Result) :-
( if
Term = term.functor(term.atom("-"),
[ItemNameArityTerm, VersionNumberTerm], _),
ItemNameArityTerm = term.functor(term.atom("/"),
[NameTerm, ArityTerm], _),
ParseName(NameTerm, SymName),
term_int.decimal_term_to_int(ArityTerm, Arity),
parse_version_number_term(VersionNumberTerm, VersionNumber)
then
Result = ok1(recomp_item_name(SymName, Arity) - VersionNumber)
else
Pieces = [words("Error in item version number."), nl],
Spec = simplest_spec($pred, severity_error, phase_term_to_parse_tree,
get_term_context(Term), Pieces),
Result = error1([Spec])
).
%---------------------------------------------------------------------------%
:- end_module recompilation.version.
%---------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink