[m-rev.] diff: equiv types in interface files

[Mark Brown]

Hi,

This problem was causing my kind inference pass to abort due to undefined
types.  I'm going to go ahead and commit it so I can continue to work
on kind checking -- this change has already passed bootcheck.  If there
are any issues I shall address them post-commit.

Cheers,
Mark.

Estimated hours taken: 4
Branches: main

compiler/modules.m:
	When determining the type constructors that are needed in the
	implementation section of an interface file, unfold equivalence
	types until no more type constructors are added, rather than
	just unfolding one level.

	Previously, there could be equivalence types referred to in the
	implementation section which would not actually be defined anywhere
	visible.  Later processing of all type definitions may have led to
	map lookup failures.

Index: compiler/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.330
diff -u -r1.330 modules.m
--- compiler/modules.m	18 May 2005 05:21:06 -0000	1.330
+++ compiler/modules.m	22 May 2005 09:23:43 -0000
@@ -1752,12 +1752,12 @@
     % Figure out the set of abstract equivalence type constructors
     % (i.e. the types that are exported as abstract types and which are defined
     % in the implementation section as equivalence types or as foreign types).
-    % Return in NecessaryTypeCtors this set, plus the set of private type
-    % constructors referred to by the right hand side of *any* type definition
-    % for those constructors.
+    % Return in NecessaryTypeCtors the smallest set containing those
+    % constructors, and the set of private type constructors referred to
+    % by the right hand side of any equivalence type in NecessaryTypeCtors.
     %
     % Given a du type definition in the implementation section, we should
-    % include it in AbsEqvRhsTypeCtors if the type constructor is abstract
+    % include it in AbsEqvLhsTypeCtors if the type constructor is abstract
     % exported and the implementation section also contains a foreign_type
     % definition of the type constructor.
     %
@@ -1772,9 +1772,7 @@
     multi_map.to_flat_assoc_list(ImplTypeMap, ImplTypes),
     list.foldl(accumulate_abs_eqv_type_lhs(InterfaceTypeMap), ImplTypes,
         set.init, AbsEqvLhsTypeCtors),
-    list.foldl(accumulate_abs_eqv_type_rhs(AbsEqvLhsTypeCtors), ImplTypes,
-        set.init, AbsEqvRhsTypes),
-    get_user_type_ctors_and_modules_from_types(AbsEqvRhsTypes,
+    set.fold2(accumulate_abs_eqv_type_rhs(ImplTypeMap), AbsEqvLhsTypeCtors,
         set.init, AbsEqvRhsTypeCtors, set.init, Modules),
     set.union(AbsEqvLhsTypeCtors, AbsEqvRhsTypeCtors, NecessaryTypeCtors).
 
@@ -1803,56 +1801,76 @@
         true
     ).
 
-:- pred accumulate_abs_eqv_type_rhs(set(type_ctor)::in,
-    pair(type_ctor, pair(type_defn, item_and_context))::in,
-    set(type)::in, set(type)::out) is det.
+:- pred accumulate_abs_eqv_type_rhs(type_defn_map::in, type_ctor::in,
+    set(type_ctor)::in, set(type_ctor)::out,
+    set(module_name)::in, set(module_name)::out) is det.
 
-accumulate_abs_eqv_type_rhs(AbsEqvLhsTypeCtors,
-        TypeCtor - (TypeDefn - _ItemAndContext), !AbsEqvRhsTypes) :-
+accumulate_abs_eqv_type_rhs(ImplTypeMap, TypeCtor, !AbsEqvRhsTypeCtors,
+        !Modules) :-
     (
-        TypeDefn = eqv_type(RhsType),
-        set.member(TypeCtor, AbsEqvLhsTypeCtors)
+        map.search(ImplTypeMap, TypeCtor, TypeDefns)
     ->
-        svset.insert(RhsType, !AbsEqvRhsTypes)
+        list.foldl2(accumulate_abs_eqv_type_rhs_2(ImplTypeMap), TypeDefns,
+            !AbsEqvRhsTypeCtors, !Modules)
     ;
         true
     ).
 
-    % Given a list of types, return the set of user-defined type constructors
-    % occurring in those types, and the set of modules that define these type
-    % constructors.
-    %
-    % NOTE: This assumes that everything has been module qualified.
-    %
-:- pred get_user_type_ctors_and_modules_from_types(set(type)::in,
+:- pred accumulate_abs_eqv_type_rhs_2(type_defn_map::in,
+    pair(type_defn, item_and_context)::in,
     set(type_ctor)::in, set(type_ctor)::out,
     set(module_name)::in, set(module_name)::out) is det.
 
-get_user_type_ctors_and_modules_from_types(Types, !TypeCtors, !Modules) :-
-    list.foldl2(get_user_type_ctors_and_modules_from_type,
-        set__to_sorted_list(Types), !TypeCtors, !Modules).
+accumulate_abs_eqv_type_rhs_2(ImplTypeMap, TypeDefn - _, !AbsEqvRhsTypeCtors,
+        !Modules) :-
+    (
+        TypeDefn = eqv_type(RhsType)
+    ->
+        type_to_type_ctor_set(RhsType, set.init, RhsTypeCtors),
+        set.difference(RhsTypeCtors, !.AbsEqvRhsTypeCtors, NewRhsTypeCtors),
+        set.fold(accumulate_modules, NewRhsTypeCtors, !Modules),
+        set.union(NewRhsTypeCtors, !AbsEqvRhsTypeCtors),
+        set.fold2(accumulate_abs_eqv_type_rhs(ImplTypeMap), NewRhsTypeCtors,
+            !AbsEqvRhsTypeCtors, !Modules)
+    ;
+        true
+    ).
 
-:- pred get_user_type_ctors_and_modules_from_type((type)::in,
-    set(type_ctor)::in, set(type_ctor)::out,
-    set(module_name)::in, set(module_name)::out) is det.
+:- pred accumulate_modules(type_ctor::in, set(module_name)::in,
+    set(module_name)::out) is det.
 
-get_user_type_ctors_and_modules_from_type(Type, !TypeCtors, !Modules) :-
+accumulate_modules(TypeCtor, !Modules) :-
+    % NOTE: This assumes that everything has been module qualified.
+    TypeCtor = SymName - _Arity,
+    (
+        sym_name_get_module_name(SymName, ModuleName)
+    ->
+        svset.insert(ModuleName, !Modules)
+    ;
+        unexpected(this_file, "accumulate_modules/3: unknown type encountered")
+    ).
+
+    % Given a type, return the set of user-defined type constructors
+    % occurring in it.
+    %
+:- pred type_to_type_ctor_set((type)::in, set(type_ctor)::in,
+    set(type_ctor)::out) is det.
+
+type_to_type_ctor_set(Type, !TypeCtors) :-
     ( type_to_ctor_and_args(Type, TypeCtor, Args) ->
         TypeCtor = SymName - _Arity,
         (
             type_ctor_is_higher_order(TypeCtor, _, _, _)
         ->
-            % Higher-order types are builtin so just get the type_ctors and
-            % modules required by the arguments.
-            list.foldl2(get_user_type_ctors_and_modules_from_type, Args,
-                !TypeCtors, !Modules)
+            % Higher-order types are builtin so just get the type_ctors
+            % from the arguments.
+            true
         ;
             type_ctor_is_tuple(TypeCtor)
         ->
-            % Tuples are builtin so just get the type_ctors and modules
-            % required by the arguments.
-            list.foldl2(get_user_type_ctors_and_modules_from_type, Args,
-                !TypeCtors, !Modules)
+            % Tuples are builtin so just get the type_ctors from the
+            % arguments.
+            true
         ;
             ( SymName = unqualified("int")
             ; SymName = unqualified("float")
@@ -1863,17 +1881,9 @@
             % We don't need to import these modules as the types are builtin.
             true
         ;
-            sym_name_get_module_name(SymName, ModuleName)
-        ->
-            svset.insert(TypeCtor, !TypeCtors),
-            svset.insert(ModuleName, !Modules),
-            list.foldl2(get_user_type_ctors_and_modules_from_type, Args,
-                !TypeCtors, !Modules)
-        ;
-            unexpected(this_file,
-                "get_user_type_ctors_modules_from_type/5: " ++
-                "unknown type encountered")
-        )
+            svset.insert(TypeCtor, !TypeCtors)
+        ),
+        list.foldl(type_to_type_ctor_set, Args, !TypeCtors)
     ;
         true
     ).
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------