[m-rev.] for review: fix mantis bug #43

[Peter Wang]

Branches: main

Fix Mantis bug #43.  The compiler was aborting when making an `.opt' file when
`--intermod-unused-args' was enabled for the following test case.  The problem
was that polymorphism wasn't adding all type variables in typeclass
constraints into the procedure's type_info varmap.

It also revealed a problem where we were writing out unused args pragmas for
type specialised procedures.  The compiler aborts when reading them back in,
as for other analyses.

compiler/polymorphism.m:
	In `record_constraint_type_info_locns', when working out which type
	variables we haven't seen before, we only checked type variables which
	appear directly in a constraint, e.g. `tc(T)'.  We also need to check
	variables which appear in type constructors, e.g. `tc(tt(T))'.

compiler/unused_args.m:
	Don't write out unused args pragmas for type specialised procedures.

	Convert some lambdas into predicates.

tests/valid/Mercury.options:
tests/valid/Mmakefile:
tests/valid/intermod_ua_type_spec.m:
	Add test case.

Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.328
diff -u -r1.328 polymorphism.m
--- compiler/polymorphism.m	27 Feb 2008 07:23:12 -0000	1.328
+++ compiler/polymorphism.m	5 Mar 2008 00:54:31 -0000
@@ -409,6 +409,7 @@
 :- import_module map.
 :- import_module pair.
 :- import_module set.
+:- import_module solutions.
 :- import_module string.
 :- import_module term.
 :- import_module varset.
@@ -3017,9 +3018,10 @@
     % quantified predicates or deconstructs existentially quantified
     % terms).
     poly_info_get_rtti_varmaps(!.Info, RttiVarMaps0),
-    IsNew = (pred(TypeAndIndex::in, TVarAndIndex::out) is semidet :-
-        TypeAndIndex = Type - Index,
-        Type = type_variable(TypeVar, _),
+    NewTVarAndIndex = (pred(TVarAndIndex::out) is nondet :-
+        list.member(Type - Index, IndexedClassTypes),
+        type_vars(Type, TypeVars),
+        list.member(TypeVar, TypeVars),
         ( rtti_search_type_info_locn(RttiVarMaps0, TypeVar, TypeInfoLocn) ->
             TypeInfoLocn = type_info(_)
         ;
@@ -3027,7 +3029,7 @@
         ),
         TVarAndIndex = TypeVar - Index
     ),
-    list.filter_map(IsNew, IndexedClassTypes, NewClassTypeVars),
+    solutions(NewTVarAndIndex, NewClassTypeVars),

     % Make an entry in the TypeInfo locations map for each new type
     % variable. The type variable can be found at the previously calculated
@@ -3041,10 +3043,6 @@
     list.foldl(MakeEntry, NewClassTypeVars, RttiVarMaps0, RttiVarMaps),
     poly_info_set_rtti_varmaps(RttiVarMaps, !Info).

-:- pred make_index(T::in, pair(T, int)::out, int::in, int::out) is det.
-
-make_index(Item, Item - Index, Index, Index + 1).
-
 :- pred new_typeclass_info_var(prog_constraint::in, string::in,
     prog_var::out, poly_info::in, poly_info::out) is det.

Index: compiler/unused_args.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unused_args.m,v
retrieving revision 1.151
diff -u -r1.151 unused_args.m
--- compiler/unused_args.m	21 Feb 2008 04:22:42 -0000	1.151
+++ compiler/unused_args.m	5 Mar 2008 00:54:31 -0000
@@ -547,15 +547,15 @@
 setup_typeinfo_dep(Var, VarTypeMap, PredProcId, RttiVarMaps, !VarDep) :-
     map.lookup(VarTypeMap, Var, Type),
     type_vars(Type, TVars),
-    list.map((pred(TVar::in, TypeInfoVar::out) is det :-
-        rtti_lookup_type_info_locn(RttiVarMaps, TVar, Locn),
-        type_info_locn_var(Locn, TypeInfoVar)
-    ), TVars, TypeInfoVars),
-    AddArgDependency =
-        (pred(TVar::in, VarDepA::in, VarDepB::out) is det :-
-            add_arg_dep(TVar, PredProcId, Var, VarDepA, VarDepB)
-        ),
-    list.foldl(AddArgDependency, TypeInfoVars, !VarDep).
+    list.map(tvar_to_type_info_var(RttiVarMaps), TVars, TypeInfoVars),
+    list.foldl(add_rev_arg_dep(Var, PredProcId), TypeInfoVars, !VarDep).
+
+:- pred tvar_to_type_info_var(rtti_varmaps::in, tvar::in, prog_var::out)
+    is det.
+
+tvar_to_type_info_var(RttiVarMaps, TVar, TypeInfoVar) :-
+    rtti_lookup_type_info_locn(RttiVarMaps, TVar, Locn),
+    type_info_locn_var(Locn, TypeInfoVar).

     % Get output arguments for a procedure given the headvars and the
     % argument modes, and set them as used.
@@ -777,6 +777,12 @@
         true
     ).

+:- pred add_rev_arg_dep(prog_var::in, pred_proc_id::in, prog_var::in,
+    var_dep::in, var_dep::out) is det.
+
+add_rev_arg_dep(Var, PredProcId, Arg, !VarDep) :-
+    add_arg_dep(Arg, PredProcId, Var, !VarDep).
+
     % Partition the arguments to a deconstruction into inputs
     % and outputs.
     %
@@ -1749,6 +1755,9 @@
                 string.right(Name, IdLen, Id),
                 string.to_int(Id, _)
             ),
+            module_info_get_type_spec_info(ModuleInfo, TypeSpecInfo),
+            TypeSpecInfo = type_spec_info(_, TypeSpecForcePreds, _, _),
+            \+ set.member(PredId, TypeSpecForcePreds),
             % XXX We don't currently generate pragmas for the automatically
             % generated class instance methods because the compiler aborts
             % when trying to read them back in from the `.opt' files.
Index: tests/valid/Mercury.options
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/valid/Mercury.options,v
retrieving revision 1.46
diff -u -r1.46 Mercury.options
--- tests/valid/Mercury.options	4 Mar 2008 00:36:06 -0000	1.46
+++ tests/valid/Mercury.options	5 Mar 2008 00:54:31 -0000
@@ -75,6 +75,7 @@
 MCFLAGS-intermod_typeclass	= --intermodule-optimization
 MCFLAGS-intermod_type_spec_2	= --intermodule-optimization
 MCFLAGS-intermod_type_spec	= --intermodule-optimization
+MCFLAGS-intermod_ua_type_spec	= --intermod-unused-args
 MCFLAGS-intermod_user_equality2	= --intermodule-optimization
 MCFLAGS-intermod_user_equality	= --intermodule-optimization
 MCFLAGS-intermod_user_equality_nested2	= --intermodule-optimization
Index: tests/valid/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/valid/Mmakefile,v
retrieving revision 1.208
diff -u -r1.208 Mmakefile
--- tests/valid/Mmakefile	4 Mar 2008 00:36:06 -0000	1.208
+++ tests/valid/Mmakefile	5 Mar 2008 00:54:31 -0000
@@ -133,6 +133,7 @@
 	intermod_test \
 	intermod_type_spec \
 	intermod_typeclass \
+	intermod_ua_type_spec \
 	intermod_user_equality \
 	intermod_user_equality_nested \
 	intermod_user_sharing \
Index: tests/valid/intermod_ua_type_spec.m
===================================================================
RCS file: tests/valid/intermod_ua_type_spec.m
diff -N tests/valid/intermod_ua_type_spec.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/valid/intermod_ua_type_spec.m	5 Mar 2008 00:54:31 -0000
@@ -0,0 +1,26 @@
+% Regression test. The compiler aborted when making the optimisation interface
+% file for this module when --intermod-unused-args is enabled.
+%
+% Uncaught Mercury exception:
+% Software Error: map.lookup: key not found
+%         Key Type: term.var(parse_tree.prog_data.tvar_type)
+%         Key Value: var(1)
+%         Value Type: hlds.hlds_rtti.type_info_locn
+
+:- module intermod_ua_type_spec.
+:- interface.
+
+:- type tt(T) ---> tt.
+
+:- typeclass tc(T) where [].
+:- instance tc(tt(_)).
+
+:- func myfunc(T) = int <= tc(T).
+:- pragma type_spec(myfunc/1, T = tt(_)).
+
+:- implementation.
+
+:- instance tc(tt(_)) where [].
+
+myfunc(_) = 0.
+
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------