%-----------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et %-----------------------------------------------------------------------------% % Copyright (C) 2001-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_version.m. % Main author: stayl. % % Compute version numbers for program items in interface files. % %-----------------------------------------------------------------------------% :- module recompilation.version. :- interface. :- import_module libs.timestamp. :- import_module parse_tree.prog_item. :- import_module parse_tree.prog_io_util. :- import_module io. :- import_module maybe. :- import_module term. %-----------------------------------------------------------------------------% % compute_version_numbers(SourceFileModTime, NewItems, MaybeOldItems, % VersionNumbers). % :- pred compute_version_numbers(timestamp::in, list(item)::in, maybe(list(item))::in, version_numbers::out) is det. :- pred write_version_numbers(version_numbers::in, io::di, io::uo) is det. :- pred parse_version_numbers(term::in, maybe1(version_numbers)::out) is det. % The version number for the format of the version numbers % written to the interface files. % :- func version_numbers_version_number = int. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% :- implementation. :- import_module hlds.hlds_out. :- import_module hlds.hlds_out.hlds_out_mode. :- import_module parse_tree.error_util. :- import_module parse_tree.mercury_to_mercury. :- import_module parse_tree.prog_io_sym_name. :- import_module parse_tree.prog_type. :- import_module parse_tree.prog_type_subst. :- import_module assoc_list. :- import_module bool. :- import_module list. :- import_module map. :- import_module require. :- import_module string. :- import_module varset. %-----------------------------------------------------------------------------% compute_version_numbers(SourceFileTime, Items, MaybeOldItems, version_numbers(ItemVersionNumbers, InstanceVersionNumbers)) :- gather_items(section_implementation, Items, GatheredItems, InstanceItems), ( MaybeOldItems = yes(OldItems0), OldItems0 = [FirstItem, VersionNumberItem | OldItems], FirstItem = item_module_defn(FirstItemModuleDefn), FirstItemModuleDefn = item_module_defn_info(md_interface, _, _), VersionNumberItem = item_module_defn(VersionNumberItemModuleDefn), VersionNumberItemModuleDefn = item_module_defn_info( md_version_numbers(_, OldVersionNumbers), _, _) -> OldVersionNumbers = version_numbers(OldItemVersionNumbers, OldInstanceVersionNumbers), gather_items(section_implementation, OldItems, GatheredOldItems, OldInstanceItems) ; % There were no old version numbers, so every item % gets the same timestamp as the source module. OldItemVersionNumbers = init_item_id_set(map.init), GatheredOldItems = init_item_id_set(map.init), map.init(OldInstanceItems), map.init(OldInstanceVersionNumbers) ), compute_item_version_numbers(SourceFileTime, GatheredItems, GatheredOldItems, OldItemVersionNumbers, ItemVersionNumbers), compute_instance_version_numbers(SourceFileTime, InstanceItems, OldInstanceItems, OldInstanceVersionNumbers, InstanceVersionNumbers). :- pred compute_item_version_numbers(timestamp::in, gathered_items::in, gathered_items::in, item_version_numbers::in, item_version_numbers::out) is det. compute_item_version_numbers(SourceFileTime, GatheredItems, GatheredOldItems, OldVersionNumbers, VersionNumbers) :- VersionNumbers = map_ids(compute_item_version_numbers_2(SourceFileTime, GatheredOldItems, OldVersionNumbers), GatheredItems, map.init). :- func compute_item_version_numbers_2(timestamp, gathered_items, item_version_numbers, item_type, map(pair(string, arity), assoc_list(section, item))) = map(pair(string, arity), timestamp). compute_item_version_numbers_2(SourceFileTime, GatheredOldItems, OldVersionNumbers, ItemType, Items0) = map.map_values(compute_item_version_numbers_3(SourceFileTime, GatheredOldItems, OldVersionNumbers, ItemType), Items0). :- func compute_item_version_numbers_3(timestamp, gathered_items, item_version_numbers, item_type, pair(string, arity), assoc_list(section, item)) = timestamp. compute_item_version_numbers_3(SourceFileTime, GatheredOldItems, OldVersionNumbers, ItemType, NameArity, Items) = ( OldIds = extract_ids(GatheredOldItems, ItemType), map.search(OldIds, NameArity, OldItems), items_are_unchanged(OldItems, Items), map.search(extract_ids(OldVersionNumbers, ItemType), NameArity, OldVersionNumber) -> OldVersionNumber ; SourceFileTime ). :- pred compute_instance_version_numbers(timestamp::in, instance_item_map::in, instance_item_map::in, instance_version_numbers::in, instance_version_numbers::out) is det. compute_instance_version_numbers(SourceFileTime, InstanceItems, OldInstanceItems, OldInstanceVersionNumbers, InstanceVersionNumbers) :- InstanceVersionNumbers = map.map_values( (func(ClassId, Items) = VersionNumber :- ( map.search(OldInstanceItems, ClassId, OldItems), items_are_unchanged(OldItems, Items), map.search(OldInstanceVersionNumbers, ClassId, OldVersionNumber) -> VersionNumber = OldVersionNumber ; VersionNumber = SourceFileTime ) ), InstanceItems ). :- pred gather_items(section::in, list(item)::in, gathered_items::out, instance_item_map::out) is det. gather_items(Section, Items, GatheredItems, Instances) :- list.reverse(Items, RevItems), Info0 = gathered_item_info(init_item_id_set(map.init), [], [], map.init), list.foldl2(gather_items_2, RevItems, Section, _, Info0, Info1), % Items which could appear in _OtherItems (those which aren't gathered % into the list for another type of item) can't appear in the interface % section. Those other items (e.g. assertions) will need to be handled here % when smart recompilation is made to work with % `--intermodule-optimization'. Info1 = gathered_item_info(GatheredItems1, PragmaItems, _OtherItems, Instances), list.reverse(PragmaItems, RevPragmaItems), list.foldl(distribute_pragma_items, RevPragmaItems, GatheredItems1, GatheredItems). :- pred distribute_pragma_items( {maybe_pred_or_func_id, item, section}::in, gathered_items::in, gathered_items::out) is det. distribute_pragma_items({ItemId, Item, Section}, !GatheredItems) :- ItemId = MaybePredOrFunc - 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. AddIfNotExisting = yes, ItemName = item_name(SymName, Arity), ( MaybePredOrFunc = yes(PredOrFunc), ItemType = pred_or_func_to_item_type(PredOrFunc), add_gathered_item(Item, item_id(ItemType, ItemName), Section, AddIfNotExisting, !GatheredItems) ; MaybePredOrFunc = no, add_gathered_item(Item, item_id(predicate_item, ItemName), Section, AddIfNotExisting, !GatheredItems), add_gathered_item(Item, item_id(function_item, ItemName), Section, AddIfNotExisting, !GatheredItems) ), % Pragmas can apply to typeclass methods. map.map_values_only(distribute_pragma_items_class_items(MaybePredOrFunc, SymName, Arity, Item, Section), extract_ids(!.GatheredItems, typeclass_item), GatheredTypeClasses), !:GatheredItems = update_ids(!.GatheredItems, typeclass_item, GatheredTypeClasses). :- pred distribute_pragma_items_class_items(maybe(pred_or_func)::in, sym_name::in, arity::in, item::in, section::in, assoc_list(section, item)::in, assoc_list(section, item)::out) is det. distribute_pragma_items_class_items(MaybePredOrFunc, SymName, Arity, Item, Section, !ClassItems) :- ( % Does this pragma match any of the methods of this class. list.member(_ - ClassItem, !.ClassItems), ClassItem = item_typeclass(ClassItemTypeClass), Interface = ClassItemTypeClass ^ tc_class_methods, Interface = class_interface_concrete(Methods), list.member(Method, Methods), Method = method_pred_or_func(_, _, _, MethodPredOrFunc, SymName, TypesAndModes, WithType, _, _, _, _, _, _), ( MaybePredOrFunc = yes(MethodPredOrFunc) ; MaybePredOrFunc = no ), ( WithType = no, adjust_func_arity(MethodPredOrFunc, Arity, list.length(TypesAndModes)) ; % We don't know the actual arity, so just match on the name % and pred_or_func. WithType = yes(_) ) -> % XXX O(N^2), but shouldn't happen too often. !:ClassItems = !.ClassItems ++ [Section - Item] ; true ). :- type gathered_item_info ---> gathered_item_info( gathered_items :: gathered_items, pragma_items :: list({maybe_pred_or_func_id, item, section}), other_items :: list(item), instances :: instance_item_map ). :- type instance_item_map == map(item_name, assoc_list(section, item)). % The constructors set should always be empty. :- type gathered_items == item_id_set(gathered_item_map). :- type gathered_item_map == map(pair(string, arity), assoc_list(section, item)). :- pred gather_items_2(item::in, section::in, section::out, gathered_item_info::in, gathered_item_info::out) is det. gather_items_2(Item, !Section, !Info) :- ( Item = item_module_defn(ItemModuleDefn), ItemModuleDefn = item_module_defn_info(md_interface, _, _) -> !:Section = section_interface ; Item = item_module_defn(ItemModuleDefn), ItemModuleDefn = item_module_defn_info(md_implementation, _, _) -> !:Section = section_implementation ; Item = item_type_defn(ItemTypeDefn) -> ItemTypeDefn = item_type_defn_info(VarSet, Name, Args, Body, Cond, Context, SeqNum), ( 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_du_type(_, _, _), % XXX does the abstract_details matter here? AbstractDetails = abstract_type_general, NameItemTypeDefn = item_type_defn_info(VarSet, Name, Args, parse_tree_abstract_type(AbstractDetails), Cond, Context, SeqNum), NameItem = item_type_defn(NameItemTypeDefn), 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 ), TypeCtorItem = item_name(Name, list.length(Args)), GatheredItems0 = !.Info ^ gathered_items, add_gathered_item(NameItem, item_id(type_abstract_item, TypeCtorItem), !.Section, yes, GatheredItems0, GatheredItems1), add_gathered_item(BodyItem, item_id(type_body_item, TypeCtorItem), !.Section, yes, GatheredItems1, GatheredItems), !Info ^ gathered_items := GatheredItems ; Item = item_instance(ItemInstance) -> ItemInstance = item_instance_info(_, ClassName, ClassArgs, _, _, _, _, _), Instances0 = !.Info ^ instances, ClassArity = list.length(ClassArgs), ClassItemName = item_name(ClassName, ClassArity), NewInstanceItem = !.Section - Item, ( map.search(Instances0, ClassItemName, OldInstanceItems) -> NewInstanceItems = [NewInstanceItem | OldInstanceItems], map.det_update(ClassItemName, NewInstanceItems, Instances0, Instances) ; map.det_insert(ClassItemName, [NewInstanceItem], Instances0, Instances) ), !Info ^ instances := Instances ; % 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. Item = item_mode_decl(ItemModeDecl), ItemModeDecl = item_mode_decl_info(_, MaybePredOrFunc, SymName, Modes, WithInst, _, _, _, _), MaybePredOrFunc = no, WithInst = yes(_) -> GatheredItems0 = !.Info ^ gathered_items, ItemName = item_name(SymName, list.length(Modes)), add_gathered_item(Item, item_id(predicate_item, ItemName), !.Section, yes, GatheredItems0, GatheredItems1), add_gathered_item(Item, item_id(function_item, ItemName), !.Section, yes, GatheredItems1, GatheredItems), !Info ^ gathered_items := GatheredItems ; item_to_item_id(Item, ItemId) -> GatheredItems0 = !.Info ^ gathered_items, add_gathered_item(Item, ItemId, !.Section, yes, GatheredItems0, GatheredItems), !Info ^ gathered_items := GatheredItems ; Item = item_pragma(ItemPragma), ItemPragma = item_pragma_info(_, PragmaType, _, _), is_pred_pragma(PragmaType, yes(PredOrFuncId)) -> PragmaItems = !.Info ^ pragma_items, !Info ^ pragma_items := [{PredOrFuncId, Item, !.Section} | PragmaItems] ; OtherItems = !.Info ^ other_items, !Info ^ other_items := [Item | OtherItems] ). :- pred add_gathered_item(item::in, item_id::in, section::in, bool::in, gathered_items::in, gathered_items::out) is det. add_gathered_item(Item, ItemId, Section, AddIfNotExisting, !GatheredItems) :- ItemId = item_id(ItemType, ItemName), ItemName = item_name(SymName, Arity), Name = unqualify_name(SymName), IdMap0 = extract_ids(!.GatheredItems, ItemType), NameArity = Name - Arity, ( map.search(IdMap0, NameArity, MatchingItems0) -> MatchingItems = MatchingItems0 ; MatchingItems = [] ), ( MatchingItems = [], AddIfNotExisting = no -> true ; add_gathered_item_2(Item, ItemType, NameArity, Section, MatchingItems, !GatheredItems) ). :- pred add_gathered_item_2(item::in, item_type::in, pair(string, arity)::in, section::in, assoc_list(section, item)::in, gathered_items::in, gathered_items::out) is det. add_gathered_item_2(Item, ItemType, NameArity, Section, MatchingItems0, !GatheredItems) :- % mercury_to_mercury.m splits combined pred and mode declarations. % That needs to be done here as well the item list read from the interface % file will match the item list generated here. ( Item = item_pred_decl(ItemPredDecl), ItemPredDecl = item_pred_decl_info(Origin, TVarSet, InstVarSet, ExistQVars, PredOrFunc, PredName, TypesAndModes, WithType, WithInst, Det, Cond, Purity, ClassContext, Context, SeqNum), split_types_and_modes(TypesAndModes, Types, MaybeModes), MaybeModes = yes(Modes), ( Modes = [_ | _] ; WithInst = yes(_) ) -> TypesWithoutModes = list.map((func(Type) = type_only(Type)), Types), varset.init(EmptyInstVarSet), PredItemPredDecl = item_pred_decl_info(Origin, TVarSet, EmptyInstVarSet, ExistQVars, PredOrFunc, PredName, TypesWithoutModes, WithType, no, no, Cond, Purity, ClassContext, Context, SeqNum), PredItem = item_pred_decl(PredItemPredDecl), ( 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(InstVarSet, MaybePredOrFunc, PredName, Modes, WithInst, Det, Cond, Context, SeqNum), ModeItem = item_mode_decl(ModeItemModeDecl), MatchingItems = [Section - PredItem, Section - ModeItem | MatchingItems0] ; Item = item_typeclass(ItemTypeClass), ItemTypeClass ^ tc_class_methods = class_interface_concrete(Methods0) -> MethodsList = list.map(split_class_method_types_and_modes, Methods0), list.condense(MethodsList, Methods), NewItemTypeClass = ItemTypeClass ^ tc_class_methods := class_interface_concrete(Methods), NewItem = item_typeclass(NewItemTypeClass), MatchingItems = [Section - NewItem | MatchingItems0] ; MatchingItems = [Section - Item | MatchingItems0] ), IdMap0 = extract_ids(!.GatheredItems, ItemType), map.set(NameArity, MatchingItems, IdMap0, IdMap), !:GatheredItems = update_ids(!.GatheredItems, ItemType, IdMap). :- func split_class_method_types_and_modes(class_method) = class_methods. split_class_method_types_and_modes(Method0) = Methods :- % Always strip the context from the item -- this is needed % so the items can be easily tested for equality. Method0 = method_pred_or_func(TVarSet, InstVarSet, ExistQVars, PredOrFunc, SymName, TypesAndModes, WithType, WithInst, MaybeDet, Cond, Purity, ClassContext, _), ( split_types_and_modes(TypesAndModes, Types, MaybeModes), MaybeModes = yes(Modes), ( Modes = [_ | _] ; WithInst = yes(_) ) -> TypesWithoutModes = list.map((func(Type) = type_only(Type)), Types), ( 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) ), PredOrFuncModeItem = method_pred_or_func_mode(InstVarSet, MaybePredOrFunc, SymName, Modes, WithInst, MaybeDet, Cond, term.context_init), PredOrFuncModeItems = [PredOrFuncModeItem] ; TypesWithoutModes = TypesAndModes, PredOrFuncModeItems = [] ), varset.init(EmptyInstVarSet), PredOrFuncItem = method_pred_or_func(TVarSet, EmptyInstVarSet, ExistQVars, PredOrFunc, SymName, TypesWithoutModes, WithType, no, no, Cond, Purity, ClassContext, term.context_init), Methods = [PredOrFuncItem | PredOrFuncModeItems]. split_class_method_types_and_modes(Method0) = [Method] :- % Always strip the context from the item -- this is needed % so the items can be easily tested for equality. Method0 = method_pred_or_func_mode(A, B, C, D, E, F, G, _), Method = method_pred_or_func_mode(A, B, C, D, E, F, G, term.context_init). :- pred item_to_item_id(item::in, item_id::out) is semidet. item_to_item_id(Item, ItemId) :- item_to_item_id_2(Item, yes(ItemId)). :- pred item_to_item_id_2(item::in, maybe(item_id)::out) is det. item_to_item_id_2(Item, MaybeItemId) :- ( ( Item = item_module_start(_) ; Item = item_module_end(_) ; Item = item_module_defn(_) ; Item = item_clause(_) ; Item = item_promise(_) ; Item = item_initialise(_) ; Item = item_finalise(_) ; Item = item_mutable(_) ; Item = item_nothing(_) ), MaybeItemId = no ; Item = item_type_defn(ItemTypeDefn), ItemTypeDefn = item_type_defn_info(_, Name, Params, _, _, _, _), list.length(Params, Arity), ItemId = item_id(type_abstract_item, item_name(Name, Arity)), MaybeItemId = yes(ItemId) ; Item = item_inst_defn(ItemInstDefn), ItemInstDefn = item_inst_defn_info(_, Name, Params, _, _, _, _), list.length(Params, Arity), ItemId = item_id(inst_item, item_name(Name, Arity)), MaybeItemId = yes(ItemId) ; Item = item_mode_defn(ItemModeDefn), ItemModeDefn = item_mode_defn_info(_, Name, Params, _, _, _, _), list.length(Params, Arity), ItemId = item_id(mode_item, item_name(Name, Arity)), MaybeItemId = yes(ItemId) ; Item = item_pred_decl(ItemPredDecl), ItemPredDecl = item_pred_decl_info(_, _, _, _, PredOrFunc, SymName, TypesAndModes, WithType, _, _, _, _, _, _, _), % 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. ( WithType = no, adjust_func_arity(PredOrFunc, Arity, list.length(TypesAndModes)) ; WithType = yes(_), Arity = list.length(TypesAndModes) ), ItemType = pred_or_func_to_item_type(PredOrFunc), ItemId = item_id(ItemType, item_name(SymName, Arity)), MaybeItemId = yes(ItemId) ; Item = item_mode_decl(ItemModeDecl), ItemModeDecl = item_mode_decl_info(_, MaybePredOrFunc, SymName, Modes, _, _, _, _, _), ( MaybePredOrFunc = yes(PredOrFunc), adjust_func_arity(PredOrFunc, Arity, list.length(Modes)), ItemType = pred_or_func_to_item_type(PredOrFunc), ItemId = item_id(ItemType, item_name(SymName, Arity)), MaybeItemId = yes(ItemId) ; MaybePredOrFunc = no, % We need to handle these separately because a `:- mode' % declaration with a `with_inst` annotation could be for % a predicate or a function. MaybeItemId = no ) ; Item = item_pragma(_), % We need to handle these separately because some pragmas % may affect a predicate and a function. MaybeItemId = no ; Item = item_typeclass(ItemTypeClass), ItemTypeClass = item_typeclass_info(_, _, ClassName, ClassVars, _, _, _, _), list.length(ClassVars, ClassArity), ItemId = item_id(typeclass_item, item_name(ClassName, ClassArity)), MaybeItemId = yes(ItemId) ; Item = item_instance(_), % Instances are handled separately (unlike other items, the module % qualifier on an instance declaration is the module containing % the class, not the module containing the instance). MaybeItemId = no ). :- type maybe_pred_or_func_id == pair(maybe(pred_or_func), sym_name_and_arity). :- pred is_pred_pragma(pragma_type::in, maybe(maybe_pred_or_func_id)::out) is det. is_pred_pragma(PragmaType, MaybePredOrFuncId) :- ( ( PragmaType = pragma_foreign_decl(_, _, _) ; PragmaType = pragma_foreign_import_module(_, _) ; PragmaType = pragma_foreign_code(_, _) ; PragmaType = pragma_foreign_export_enum(_, _, _, _, _) ; PragmaType = pragma_foreign_enum(_, _, _, _) ; PragmaType = pragma_source_file(_) ; PragmaType = pragma_reserve_tag(_, _) ; PragmaType = pragma_require_feature_set(_) ), MaybePredOrFuncId = no ; ( PragmaType = pragma_inline(Name, Arity) ; PragmaType = pragma_no_inline(Name, Arity) ; PragmaType = pragma_obsolete(Name, Arity) ; PragmaType = pragma_no_detism_warning(Name, Arity) ; PragmaType = pragma_promise_semipure(Name, Arity) ; PragmaType = pragma_promise_equivalent_clauses(Name, Arity) ; PragmaType = pragma_fact_table(Name, Arity, _) ; PragmaType = pragma_promise_pure(Name, Arity) ; PragmaType = pragma_terminates(Name, Arity) ; PragmaType = pragma_does_not_terminate(Name, Arity) ; PragmaType = pragma_check_termination(Name, Arity) ; PragmaType = pragma_mode_check_clauses(Name, Arity) ), MaybePredOrFuncId = yes(no - Name / Arity) ; ( PragmaType = pragma_type_spec(Name, _, Arity, MaybePredOrFunc, _, _, _, _) ; PragmaType = pragma_tabled(_, Name, Arity, MaybePredOrFunc, _, _Attrs) ), MaybePredOrFuncId = yes(MaybePredOrFunc - Name / Arity) ; ( PragmaType = pragma_unused_args(PredOrFunc, Name, Arity, _, _) ; PragmaType = pragma_exceptions(PredOrFunc, Name, Arity, _, _) ; PragmaType = pragma_trailing_info(PredOrFunc, Name, Arity, _, _) ; PragmaType = pragma_mm_tabling_info(PredOrFunc, Name, Arity, _, _) ), MaybePredOrFuncId = yes(yes(PredOrFunc) - Name / Arity) ; PragmaType = pragma_foreign_proc(_, Name, PredOrFunc, Args, _, _, _), adjust_func_arity(PredOrFunc, Arity, list.length(Args)), MaybePredOrFuncId = yes(yes(PredOrFunc) - Name / Arity) ; ( PragmaType = pragma_termination_info(PredOrFunc, Name, Modes, _, _) ; PragmaType = pragma_foreign_export(_, Name, PredOrFunc, Modes, _) ; PragmaType = pragma_structure_sharing(PredOrFunc, Name, Modes, _,_,_) ; PragmaType = pragma_structure_reuse(PredOrFunc, Name, Modes, _, _, _) ; PragmaType = pragma_termination2_info(PredOrFunc, Name, Modes, _,_,_) ), adjust_func_arity(PredOrFunc, Arity, list.length(Modes)), MaybePredOrFuncId = yes(yes(PredOrFunc) - Name / Arity) ). % XXX This is a bit brittle (need to be careful with term.contexts). % For example, it won't work for clauses. % It will never succeed when it shouldn't, so it will never cause % a necessary recompilation to be missed. % :- pred items_are_unchanged(assoc_list(section, item)::in, assoc_list(section, item)::in) is semidet. items_are_unchanged([], []). items_are_unchanged([Section - Item1 | Items1], [Section - Item2 | Items2]) :- yes = item_is_unchanged(Item1, Item2), items_are_unchanged(Items1, Items2). % 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's 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. % :- func item_is_unchanged(item, item) = bool. item_is_unchanged(Item1, Item2) = Unchanged :- ( Item1 = item_module_start(ItemModuleStart1), ItemModuleStart1 = item_module_start_info(ModuleName, _, _), ( Item2 = item_module_start(ItemModuleStart2), ItemModuleStart2 = item_module_start_info(ModuleName, _, _) -> Unchanged = yes ; Unchanged = no ) ; Item1 = item_module_end(ItemModuleEnd1), ItemModuleEnd1 = item_module_end_info(ModuleName, _, _), ( Item2 = item_module_end(ItemModuleEnd2), ItemModuleEnd2 = item_module_end_info(ModuleName, _, _) -> Unchanged = yes ; Unchanged = no ) ; Item1 = item_module_defn(ItemModuleDefn1), ItemModuleDefn1 = item_module_defn_info(ModuleDefn, _, _), ( Item2 = item_module_defn(ItemModuleDefn2), ItemModuleDefn2 = item_module_defn_info(ModuleDefn, _, _) -> Unchanged = yes ; Unchanged = no ) ; Item1 = item_clause(ItemClause1), ItemClause1 = item_clause_info(_, _, PorF, SymName, Args, Goal, _, _), % XXX Need to compare the goals properly in clauses and assertions. % That's not necessary at the moment because smart recompilation % doesn't work with inter-module optimization yet. ( Item2 = item_clause(ItemClause2), ItemClause2 = item_clause_info(_, _, PorF, SymName, Args, Goal, _, _) -> Unchanged = yes ; Unchanged = no ) ; Item1 = item_type_defn(ItemTypeDefn1), ItemTypeDefn1 = item_type_defn_info(_, Name, Args, Defn, Cond, _, _), ( Item2 = item_type_defn(ItemTypeDefn2), ItemTypeDefn2 = item_type_defn_info(_, Name, Args, Defn, Cond, _, _) -> Unchanged = yes ; Unchanged = no ) ; Item1 = item_inst_defn(ItemInstDefn1), ItemInstDefn1 = item_inst_defn_info(_, Name, Args, Defn, Cond, _, _), ( Item2 = item_inst_defn(ItemInstDefn2), ItemInstDefn2 = item_inst_defn_info(_, Name, Args, Defn, Cond, _, _) -> Unchanged = yes ; Unchanged = no ) ; Item1 = item_mode_defn(ItemModeDefn1), ItemModeDefn1 = item_mode_defn_info(_, Name, Args, Defn, Cond, _, _), ( Item2 = item_mode_defn(ItemModeDefn2), ItemModeDefn2 = item_mode_defn_info(_, Name, Args, Defn, Cond, _, _) -> Unchanged = yes ; Unchanged = no ) ; Item1 = item_pred_decl(ItemPredDecl1), ItemPredDecl1 = item_pred_decl_info(_, TVarSet1, _, ExistQVars1, PredOrFunc, Name, TypesAndModes1, WithType1, _, Det1, Cond, Purity, Constraints1, _, _), ( Item2 = item_pred_decl(ItemPredDecl2), ItemPredDecl2 = item_pred_decl_info(_, TVarSet2, _, ExistQVars2, PredOrFunc, Name, TypesAndModes2, WithType2, _, Det2, Cond, 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) -> Unchanged = yes ; Unchanged = no ) ; Item1 = item_mode_decl(ItemModeDecl1), ItemModeDecl1 = item_mode_decl_info(InstVarSet1, PredOrFunc, Name, Modes1, WithInst1, Det, Cond, _, _), ( Item2 = item_mode_decl(ItemModeDecl2), ItemModeDecl2 = item_mode_decl_info(InstVarSet2, PredOrFunc, Name, Modes2, WithInst2, Det, Cond, _, _), pred_or_func_mode_is_unchanged(InstVarSet1, Modes1, WithInst1, InstVarSet2, Modes2, WithInst2) -> Unchanged = yes ; Unchanged = no ) ; Item1 = item_pragma(ItemPragma1), ItemPragma1 = item_pragma_info(_, PragmaType1, _, _), % 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. ( Item2 = item_pragma(ItemPragma2), ItemPragma2 = item_pragma_info(_, PragmaType2, _, _) -> ( PragmaType1 = pragma_type_spec(Name, SpecName, Arity, MaybePredOrFunc, MaybeModes, TypeSubst1, TVarSet1, _), PragmaType2 = pragma_type_spec(Name, SpecName, Arity, MaybePredOrFunc, MaybeModes, TypeSubst2, TVarSet2, _) -> assoc_list.keys_and_values(TypeSubst1, TVars1, Types1), assoc_list.keys_and_values(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), ( type_list_is_unchanged( TVarSet1, TVarTypes1 ++ Types1, TVarSet2, TVarTypes2 ++ Types2, _, _, _) -> Unchanged = yes ; Unchanged = no ) ; Unchanged = ( PragmaType1 = PragmaType2 -> yes ; no ) ) ; Unchanged = no ) ; Item1 = item_promise(ItemPromiseInfo1), ItemPromiseInfo1 = item_promise_info(PromiseType, Goal, _, UnivVars, _, _), ( Item2 = item_promise(ItemPromiseInfo2), ItemPromiseInfo2 = item_promise_info(PromiseType, Goal, _, UnivVars, _, _) -> Unchanged = yes ; Unchanged = no ) ; Item1 = item_initialise(ItemInitialise1), ItemInitialise1 = item_initialise_info(A, B, C, _, _), ( Item2 = item_initialise(ItemInitialise2), ItemInitialise2 = item_initialise_info(A, B, C, _, _) -> Unchanged = yes ; Unchanged = no ) ; Item1 = item_finalise(ItemFinalise1), ItemFinalise1 = item_finalise_info(A, B, C, _, _), ( Item2 = item_finalise(ItemFinalise2), ItemFinalise2 = item_finalise_info(A, B, C, _, _) -> Unchanged = yes ; Unchanged = no ) ; Item1 = item_mutable(ItemMutable1), ItemMutable1 = item_mutable_info(A, B, C, D, E, F, _, _), ( Item2 = item_mutable(ItemMutable2), ItemMutable2 = item_mutable_info(A, B, C, D, E, F, _, _) -> Unchanged = yes ; Unchanged = no ) ; Item1 = item_typeclass(ItemTypeClass1), ItemTypeClass1 = item_typeclass_info(Constraints, FunDeps, Name, Vars, Interface1, _, _, _), ( Item2 = item_typeclass(ItemTypeClass2), ItemTypeClass2 = item_typeclass_info(Constraints, FunDeps, Name, Vars, Interface2, _, _, _), class_interface_is_unchanged(Interface1, Interface2) -> Unchanged = yes ; Unchanged = no ) ; Item1 = item_instance(ItemInstance1), ItemInstance1 = item_instance_info(Constraints, Name, Types, Body, _, Module, _, _), ( Item2 = item_instance(ItemInstance2), ItemInstance2 = item_instance_info(Constraints, Name, Types, Body, _, Module, _, _) -> Unchanged = yes ; Unchanged = no ) ; Item1 = item_nothing(ItemNothing1), ItemNothing1 = item_nothing_info(A, _, _), ( Item2 = item_nothing(ItemNothing2), ItemNothing2 = item_nothing_info(A, _, _) -> Unchanged = yes ; Unchanged = no ) ). % 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 mercury_to_mercury.m splits % combined type and mode declarations into separate declarations. % When they are read back in the variable numbers will be different % because 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($module, $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), ( prog_type.type_list_to_var_list(SubstExistQTypes2, SubstExistQVars2) -> ExistQVars1 = SubstExistQVars2 ; unexpected($module, $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_subst(VarSet1, VarSet2, _, InstSubst), % Treat modes as terms here to use term.list_subsumes, which does just % what we want here. ModeTerms1 = list.map(mode_to_term, Modes1), ModeTerms2 = list.map(mode_to_term, Modes2), ( MaybeWithInst1 = yes(Inst1), MaybeWithInst2 = yes(Inst2), WithInstTerm1 = mode_to_term(free -> Inst1), WithInstTerm2 = mode_to_term(free -> Inst2), AllModeTerms1 = [WithInstTerm1 | ModeTerms1], AllModeTerms2 = [WithInstTerm2 | ModeTerms2] ; MaybeWithInst1 = no, MaybeWithInst2 = no, AllModeTerms1 = ModeTerms1, AllModeTerms2 = ModeTerms2 ), term.apply_substitution_to_list(AllModeTerms2, InstSubst, SubstAllModeTerms2), term.list_subsumes(AllModeTerms1, SubstAllModeTerms2, _), term.list_subsumes(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(class_methods::in, class_methods::in) is semidet. class_methods_are_unchanged([], []). class_methods_are_unchanged([Method1 | Methods1], [Method2 | Methods2]) :- ( Method1 = method_pred_or_func(TVarSet1, _, ExistQVars1, PredOrFunc, Name, TypesAndModes1, WithType1, _, Detism, Cond, Purity, Constraints1, _), Method2 = method_pred_or_func(TVarSet2, _, ExistQVars2, PredOrFunc, Name, TypesAndModes2, WithType2, _, Detism, Cond, Purity, Constraints2, _), pred_or_func_type_is_unchanged(TVarSet1, ExistQVars1, TypesAndModes1, WithType1, Constraints1, TVarSet2, ExistQVars2, TypesAndModes2, WithType2, Constraints2) ; Method1 = method_pred_or_func_mode(InstVarSet1, PredOrFunc, Name, Modes1, WithInst1, Det, Cond, _), Method2 = method_pred_or_func_mode(InstVarSet2, PredOrFunc, Name, Modes2, WithInst2, Det, Cond, _), pred_or_func_mode_is_unchanged(InstVarSet1, Modes1, WithInst1, InstVarSet2, Modes2, WithInst2) ), class_methods_are_unchanged(Methods1, Methods2). %-----------------------------------------------------------------------------% write_version_numbers(AllVersionNumbers, !IO) :- AllVersionNumbers = version_numbers(VersionNumbers, InstanceVersionNumbers), VersionNumbersList = list.filter_map( (func(ItemType) = (ItemType - ItemVersions) is semidet :- ItemVersions = extract_ids(VersionNumbers, ItemType), \+ map.is_empty(ItemVersions) ), [type_abstract_item, type_body_item, mode_item, inst_item, predicate_item, function_item, typeclass_item]), io.write_string("{\n\t", !IO), io.write_list(VersionNumbersList, ",\n\t", write_item_type_and_versions, !IO), ( map.is_empty(InstanceVersionNumbers) -> true ; ( VersionNumbersList = [] ; VersionNumbersList = [_ | _], io.write_string(",\n\t", !IO) ), io.write_string("instance(", !IO), map.to_assoc_list(InstanceVersionNumbers, InstanceAL), io.write_list(InstanceAL, ",\n\n\t", write_symname_arity_version_number, !IO), io.write_string(")\n\t", !IO) ), io.write_string("\n}", !IO). :- pred write_item_type_and_versions( pair(item_type, map(pair(string, int), version_number))::in, io::di, io::uo) is det. write_item_type_and_versions(ItemType - ItemVersions, !IO) :- string_to_item_type(ItemTypeStr, ItemType), io.write_string(ItemTypeStr, !IO), io.write_string("(\n\t\t", !IO), map.to_assoc_list(ItemVersions, ItemVersionsList), io.write_list(ItemVersionsList, ",\n\t\t", write_name_arity_version_number, !IO), io.write_string("\n\t)", !IO). :- pred write_name_arity_version_number( pair(pair(string, int), version_number)::in, io::di, io::uo) is det. write_name_arity_version_number(NameArity - VersionNumber, !IO) :- NameArity = Name - Arity, mercury_output_bracketed_sym_name(unqualified(Name), next_to_graphic_token, !IO), io.write_string("/", !IO), io.write_int(Arity, !IO), io.write_string(" - ", !IO), write_version_number(VersionNumber, !IO). :- pred write_symname_arity_version_number( pair(item_name, version_number)::in, io::di, io::uo) is det. write_symname_arity_version_number(ItemName - VersionNumber, !IO) :- ItemName = item_name(SymName, Arity), mercury_output_bracketed_sym_name(SymName, next_to_graphic_token, !IO), io.write_string("/", !IO), io.write_int(Arity, !IO), io.write_string(" - ", !IO), write_version_number(VersionNumber, !IO). %-----------------------------------------------------------------------------% version_numbers_version_number = 1. %-----------------------------------------------------------------------------% parse_version_numbers(VersionNumbersTerm, Result) :- ( VersionNumbersTerm = term.functor(term.atom("{}"), VersionNumbersTermList0, _) -> VersionNumbersTermList = VersionNumbersTermList0 ; VersionNumbersTermList = [VersionNumbersTerm] ), map_parser(parse_item_type_version_numbers, VersionNumbersTermList, Result0), ( Result0 = ok1(List), VersionNumbers0 = version_numbers(init_item_id_set(map.init), map.init), VersionNumbers = list.foldl( (func(VNResult, version_numbers(VNs0, Instances0)) = version_numbers(VNs, Instances) :- ( VNResult = items(ItemType, ItemVNs), VNs = update_ids(VNs0, ItemType, ItemVNs), Instances = Instances0 ; VNResult = instances(Instances), VNs = VNs0 ) ), List, VersionNumbers0), Result = ok1(VersionNumbers) ; Result0 = error1(Errors), Result = error1(Errors) ). :- type item_version_numbers_result ---> items(item_type, version_number_map) ; instances(instance_version_numbers). :- pred parse_item_type_version_numbers(term::in, maybe1(item_version_numbers_result)::out) is det. parse_item_type_version_numbers(Term, Result) :- ( Term = term.functor(term.atom(ItemTypeStr), ItemsVNsTerms, _), string_to_item_type(ItemTypeStr, ItemType) -> 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) ) ; Term = term.functor(term.atom("instance"), InstanceVNsTerms, _) -> 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) ) ; % XXX This is an uninformative error message. Pieces = [words("Invalid item type version numbers."), nl], Spec = error_spec(severity_error, phase_term_to_parse_tree, [simple_msg(get_term_context(Term), [always(Pieces)])]), Result = error1([Spec]) ). :- pred parse_key_version_number( pred(term, string)::(pred(in, out) is semidet), term::in, maybe1(pair(pair(string, arity), version_number))::out) is det. parse_key_version_number(ParseName, Term, Result) :- ( Term = term.functor(term.atom("-"), [ItemNameArityTerm, VersionNumberTerm], _), ItemNameArityTerm = term.functor(term.atom("/"), [NameTerm, ArityTerm], _), ParseName(NameTerm, Name), ArityTerm = term.functor(term.integer(Arity), _, _), VersionNumber = term_to_version_number(VersionNumberTerm) -> Result = ok1((Name - Arity) - VersionNumber) ; Pieces = [words("Error in item version number."), nl], Spec = error_spec(severity_error, phase_term_to_parse_tree, [simple_msg(get_term_context(Term), [always(Pieces)])]), Result = error1([Spec]) ). :- pred parse_item_version_number( pred(term, sym_name)::(pred(in, out) is semidet), term::in, maybe1(pair(item_name, version_number))::out) is det. parse_item_version_number(ParseName, Term, Result) :- ( Term = term.functor(term.atom("-"), [ItemNameArityTerm, VersionNumberTerm], _), ItemNameArityTerm = term.functor(term.atom("/"), [NameTerm, ArityTerm], _), ParseName(NameTerm, SymName), ArityTerm = term.functor(term.integer(Arity), _, _), VersionNumber = term_to_version_number(VersionNumberTerm) -> Result = ok1(item_name(SymName, Arity) - VersionNumber) ; Pieces = [words("Error in item version number."), nl], Spec = error_spec(severity_error, phase_term_to_parse_tree, [simple_msg(get_term_context(Term), [always(Pieces)])]), Result = error1([Spec]) ). %-----------------------------------------------------------------------------% :- end_module recompilation.version. %-----------------------------------------------------------------------------%