[m-rev.] Add module qualification to data ctors in inst definitions
Ralph Becket
rafe at cs.mu.OZ.AU
Wed Jun 15 17:04:54 AEST 2005
Estimated hours taken: 16
Branches: main
Fix a bug whereby the compiler was erroneously deciding that `[]' is not
a sub-inst of `list((pred) is semidet)'. The problem was that the `[]'
(taken from the code in a clause) was properly module qualified, whereas
the `[]' and `[|]' in the expansion of `list((pred) is semidet)' were not.
This was sufficient to cause inst_util.abstractly_unify_inst_list to
come to the wrong conclusion.
compiler/module_qual.m:
This module now also collects lists of data constructors and
uses this information to module qualify data constructors
appearing in inst declarations.
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.107
diff -u -r1.107 module_qual.m
--- compiler/module_qual.m 25 May 2005 03:55:46 -0000 1.107
+++ compiler/module_qual.m 10 Jun 2005 06:02:31 -0000
@@ -189,6 +189,7 @@
% visible from the implementation of the module.
modules :: module_id_set,
types :: type_id_set,
+ data_ctors :: data_ctor_id_set,
impl_types :: type_id_set,
insts :: inst_id_set,
modes :: mode_id_set,
@@ -262,7 +263,7 @@
:- pred collect_mq_info_2(item::in, mq_info::in, mq_info::out) is det.
collect_mq_info_2(clause(_, _, _, _, _), !Info).
-collect_mq_info_2(type_defn(_, SymName, Params, _, _), !Info) :-
+collect_mq_info_2(type_defn(_, SymName, Params, TypeDefn, _), !Info) :-
% This item is not visible in the current module.
( mq_info_get_import_status(!.Info, abstract_imported) ->
true
@@ -270,10 +271,16 @@
list.length(Params, Arity),
mq_info_get_types(!.Info, Types0),
mq_info_get_impl_types(!.Info, ImplTypes0),
+ mq_info_get_data_ctors(!.Info, DataCtors0),
mq_info_get_need_qual_flag(!.Info, NeedQualifier),
id_set_insert(NeedQualifier, SymName - Arity, Types0, Types),
id_set_insert(NeedQualifier, SymName - Arity,
ImplTypes0, ImplTypes),
+ % The type name has already been module qualified by prog_io.m
+ ModuleName = module_part_of_sym_name(SymName),
+ DataCtors = collect_mq_data_ctor_ids(TypeDefn, ModuleName,
+ NeedQualifier, DataCtors0),
+ mq_info_set_data_ctors(DataCtors, !Info),
mq_info_set_types(Types, !Info),
mq_info_set_impl_types(ImplTypes, !Info)
).
@@ -466,6 +473,40 @@
%-----------------------------------------------------------------------------%
+:- func collect_mq_data_ctor_ids(type_defn, sym_name, need_qualifier,
+ data_ctor_id_set) = data_ctor_id_set.
+
+collect_mq_data_ctor_ids(du_type(DataCtors, _), ModuleName, NeedQualifier,
+ DataCtorIds) =
+ list.foldl(
+ collect_mq_data_ctor_id(ModuleName, NeedQualifier),
+ DataCtors,
+ DataCtorIds
+ ).
+
+collect_mq_data_ctor_ids(eqv_type(_), _, _, DataCtorIds) = DataCtorIds.
+
+collect_mq_data_ctor_ids(abstract_type(_), _, _, DataCtorIds) = DataCtorIds.
+
+collect_mq_data_ctor_ids(solver_type(_, _), _, _, DataCtorIds) = DataCtorIds.
+
+collect_mq_data_ctor_ids(foreign_type(_, _, _), _, _, DataCtorIds) =
+ DataCtorIds.
+
+
+:- func collect_mq_data_ctor_id(sym_name, need_qualifier, constructor,
+ data_ctor_id_set) = data_ctor_id_set.
+
+collect_mq_data_ctor_id(ModuleName, NeedQualifier, ctor(_, _, Name0, Args),
+ DataCtorIds0) = DataCtorIds :-
+ Arity = list__length(Args),
+ Name = base_part_of_sym_name(Name0),
+ QualifiedName = qualified(ModuleName, Name),
+ id_set_insert(NeedQualifier, QualifiedName - Arity,
+ DataCtorIds0, DataCtorIds).
+
+%-----------------------------------------------------------------------------%
+
% process_assert(G, SNs, B)
%
% Scan the goal, G, building the list of qualified symbols, SNs.
@@ -938,15 +979,19 @@
mq_info::in, mq_info::out, io::di, io::uo) is det.
qualify_bound_inst_list([], [], !Info, !IO).
-qualify_bound_inst_list([functor(ConsId, Insts0) | BoundInsts0],
+qualify_bound_inst_list([functor(ConsId0, Insts0) | BoundInsts0],
[functor(ConsId, Insts) | BoundInsts], !Info, !IO) :-
- ( ConsId = cons(Name, Arity) ->
- Id = Name - Arity,
+ ( ConsId0 = cons(Name0, Arity0) ->
+ Id0 = Name0 - Arity0,
+ mq_info_get_data_ctors(!.Info, DataCtors),
+ find_unique_match(Id0, Id, DataCtors, data_ctor_id, !Info, !IO),
+ Id = Name - _,
+ ConsId = cons(Name, Arity0),
update_recompilation_info(
recompilation.record_used_item(functor, Id, Id),
!Info)
;
- true
+ ConsId = ConsId0
),
qualify_inst_list(Insts0, Insts, !Info, !IO),
qualify_bound_inst_list(BoundInsts0, BoundInsts, !Info, !IO).
@@ -1237,8 +1282,8 @@
% Find the unique match in the current name space for a given id
% from a list of ids. If none exists, either because no match
% was found or multiple matches were found, report an error.
- % This predicate assumes that type_ids, inst_ids, mode_ids and
- % class_ids have the same representation.
+ % This predicate assumes that type_ids, data_ctor_ids, inst_ids,
+ % mode_ids and class_ids have the same representation.
%
:- pred find_unique_match(id::in, id::out, id_set::in, id_type::in,
mq_info::in, mq_info::out, io::di, io::uo) is det.
@@ -1316,6 +1361,7 @@
:- func convert_simple_item_type(id_type) = item_type.
convert_simple_item_type(type_id) = (type).
+convert_simple_item_type(data_ctor_id) = (type_body).
convert_simple_item_type(mode_id) = (mode).
convert_simple_item_type(inst_id) = (inst).
convert_simple_item_type(class_id) = (typeclass).
@@ -1324,6 +1370,7 @@
:- type id_type
---> type_id
+ ; data_ctor_id
; mode_id
; inst_id
; class_id.
@@ -1349,7 +1396,7 @@
id_to_sym_name_and_arity(SymName - Arity) = SymName / Arity.
- % Report an undefined type, inst or mode.
+ % Report an undefined type, data constructor, inst or mode.
%
:- pred report_undefined(list(module_name)::in, mq_info::in,
id::in, id_type::in, io::di, io::uo) is det.
@@ -1469,6 +1516,7 @@
:- pred id_type_to_string(id_type::in, string::out) is det.
id_type_to_string(type_id, "type").
+id_type_to_string(data_ctor_id, "data constructor").
id_type_to_string(mode_id, "mode").
id_type_to_string(inst_id, "inst").
id_type_to_string(class_id, "typeclass").
@@ -1591,7 +1639,7 @@
MaybeRecompInfo = yes(init_recompilation_info(ModuleName))
),
Info = mq_info(ImportedModules, InterfaceVisibleModules,
- Empty, Empty, Empty, Empty, Empty, Empty,
+ Empty, Empty, Empty, Empty, Empty, Empty, Empty,
InterfaceModules0, local, 0,
no, no, ReportErrors, ErrorContext, ModuleName,
may_be_unqualified, MaybeRecompInfo).
@@ -1601,6 +1649,7 @@
set(module_name)::out) is det.
:- pred mq_info_get_modules(mq_info::in, module_id_set::out) is det.
:- pred mq_info_get_types(mq_info::in, type_id_set::out) is det.
+:- pred mq_info_get_data_ctors(mq_info::in, data_ctor_id_set::out) is det.
:- pred mq_info_get_impl_types(mq_info::in, type_id_set::out) is det.
:- pred mq_info_get_insts(mq_info::in, inst_id_set::out) is det.
:- pred mq_info_get_modes(mq_info::in, mode_id_set::out) is det.
@@ -1618,6 +1667,7 @@
mq_info_get_interface_visible_modules(Info, Info ^ interface_visible_modules).
mq_info_get_modules(Info, Info ^ modules).
mq_info_get_types(Info, Info ^ types).
+mq_info_get_data_ctors(Info, Info ^ data_ctors).
mq_info_get_impl_types(Info, Info ^ impl_types).
mq_info_get_insts(Info, Info ^ insts).
mq_info_get_modes(Info, Info ^ modes).
@@ -1640,6 +1690,8 @@
mq_info::in, mq_info::out) is det.
:- pred mq_info_set_types(type_id_set::in,
mq_info::in, mq_info::out) is det.
+:- pred mq_info_set_data_ctors(data_ctor_id_set::in,
+ mq_info::in, mq_info::out) is det.
:- pred mq_info_set_impl_types(type_id_set::in,
mq_info::in, mq_info::out) is det.
:- pred mq_info_set_insts(inst_id_set::in,
@@ -1663,6 +1715,7 @@
Info ^ interface_visible_modules := ImportedModules).
mq_info_set_modules(Modules, Info, Info ^ modules := Modules).
mq_info_set_types(Types, Info, Info ^ types := Types).
+mq_info_set_data_ctors(DataCtors, Info, Info ^ data_ctors := DataCtors).
mq_info_set_impl_types(Types, Info, Info ^ impl_types := Types).
mq_info_set_insts(Insts, Info, Info ^ insts := Insts).
mq_info_set_modes(Modes, Info, Info ^ modes := Modes).
@@ -1691,6 +1744,8 @@
mq_info_set_error_flag_2(type_id, !Info) :-
mq_info_set_type_error_flag(!Info).
+mq_info_set_error_flag_2(data_ctor_id, !Info) :-
+ mq_info_set_type_error_flag(!Info).
mq_info_set_error_flag_2(mode_id, !Info) :-
mq_info_set_mode_error_flag(!Info).
mq_info_set_error_flag_2(inst_id, !Info) :-
@@ -1733,6 +1788,7 @@
:- type id_set == map(pair(string, arity), pair(set(module_name))).
:- type type_id_set == id_set.
+:- type data_ctor_id_set == id_set.
:- type mode_id_set == id_set.
:- type inst_id_set == id_set.
:- type class_id_set == id_set.
@@ -1897,6 +1953,28 @@
get_first_module_name(unqualified(ModuleName)) = ModuleName.
get_first_module_name(qualified(Parent, _)) = get_first_module_name(Parent).
+
+%-----------------------------------------------------------------------------%
+
+ % This function is used to extract the module name part of a qualified
+ % name.
+ %
+:- func module_part_of_sym_name(sym_name) = sym_name.
+
+module_part_of_sym_name(qualified(ModuleSymName, _Name)) = ModuleSymName.
+
+module_part_of_sym_name(unqualified(_Name)) =
+ unexpected(this_file,
+ "module_part_of_sym_name: called with unqualified name").
+
+
+ % This function is the complement of module_part_of_sym_name.
+ %
+:- func base_part_of_sym_name(sym_name) = string.
+
+base_part_of_sym_name(qualified(_ModuleSymName, Name)) = Name.
+base_part_of_sym_name(unqualified(Name)) = Name.
+
%----------------------------------------------------------------------------%
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list