[m-dev.] for review: fix polymorphism bug

David Glen JEFFERY dgj at cs.mu.OZ.AU
Thu Feb 8 14:18:43 AEDT 2001


On 07-Feb-2001, Fergus Henderson <fjh at cs.mu.OZ.AU> wrote:
> On 07-Feb-2001, David Glen JEFFERY <dgj at cs.mu.OZ.AU> wrote:
> > Fix a bug reported by petdr on October 30th last year.
> > 
> > compiler/polymorphism.m:
> > 	When looking up the variable which contains a typeclass info for
> > 	a particular constraint to be passed to a call, handle the case where 
> > 	there is *no* variable for such a constraint. This occurs in the case
> > 	where the producer of the variable occurs later on in the goal (but
> > 	will get re-ordered by the mode checker). The solution is to just
> > 	create a variable for the typeclass info, and whenever creating
> > 	a `head' variable to hold a constraint being produced by a call,
> > 	check first whether there is already a variable allocated for that
> > 	constraint.
> 
> Could you please post a diff of that file with `-b'?

Can be found below. (Not sure that it will help that much more... most of 
the code that was moved around also had its indentation changed. :-( )

> Also, I think the section on "Known Bugs" in the existential types
> section of the language reference manual can be deleted now.

OK, have done. Here is a revised diff, including `-b' for polymorphism:

-----------------------------------------------------------------------------   

Estimated hours taken: 12
  
Fix a bug reported by petdr on October 30th last year.
  
compiler/polymorphism.m:
        When looking up the variable which contains a typeclass info for
        a particular constraint to be passed to a call, handle the case where
        there is *no* variable for such a constraint. This occurs in the case
        where the producer of the variable occurs later on in the goal (but
        will get re-ordered by the mode checker). The solution is to just
        create a variable for the typeclass info, and whenever creating
        a `head' variable to hold a constraint being produced by a call, 
        check first whether there is already a variable allocated for that
        constraint.

doc/reference_manual.texi:
	Delete mention of this bug from the "Known Bugs"  in the existential
	types section.
  
tests/hard_coded/typeclasses/Mmakefile:
tests/hard_coded/typeclasses/reordered_existential_constraint.exp:
tests/hard_coded/typeclasses/reordered_existential_constraint.m:
        A test case for this. (Not the same as petdr's original test case,
        but much simpler and exhibits the same bug).
  
-----------------------------------------------------------------------------
  
Index: polymorphism.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/polymorphism.m,v
retrieving revision 1.205
diff -u -t -b -r1.205 polymorphism.m
--- polymorphism.m	2001/01/15 07:15:31	1.205
+++ polymorphism.m	2001/02/06 04:00:47
@@ -861,7 +861,7 @@
         % for unconstrained, universally quantified type variables.
         % to the initial tvar->type_info_var mapping
         %
-        ToLocn = lambda([TheVar::in, TheLocn::out] is det,
+        ToLocn = (pred(TheVar::in, TheLocn::out) is det :-
                         TheLocn = type_info(TheVar)),
 
         list__map(ToLocn, UnivHeadTypeInfoVars, UnivTypeLocns),
@@ -2087,8 +2087,7 @@
                         Info1, Info).
 
 :- pred polymorphism__make_typeclass_info_var(class_constraint,
-        existq_tvars, prog_context,
-        list(hlds_goal), list(hlds_goal),
+        existq_tvars, prog_context, list(hlds_goal), list(hlds_goal),
         poly_info, poly_info, maybe(prog_var)). 
 :- mode polymorphism__make_typeclass_info_var(in, in, in, in, out,
         in, out, out) is det.
@@ -2096,28 +2095,52 @@
 polymorphism__make_typeclass_info_var(Constraint, ExistQVars,
                 Context, ExtraGoals0, ExtraGoals, 
                 Info0, Info, MaybeVar) :-
-        Constraint = constraint(ClassName, ConstrainedTypes),
-        list__length(ConstrainedTypes, ClassArity),
-        ClassId = class_id(ClassName, ClassArity),
-
-        Info0 = poly_info(VarSet0, VarTypes0, TypeVarSet, TypeInfoMap0, 
-                TypeClassInfoMap0, Proofs, PredName, ModuleInfo),
-
         (
-                map__search(TypeClassInfoMap0, Constraint, Location)
+                map__search(Info0^typeclass_info_map, Constraint, Location)
         ->
-                        % We already have a typeclass_info for this constraint
+                        % We already have a typeclass_info for this constraint,
+                        % either from a parameter to the pred or from an
+                        % existentially quantified goal that we have already
+                        % processed.
+
                 ExtraGoals = ExtraGoals0,
                 Var = Location,
                 MaybeVar = yes(Var),
                 Info = Info0
         ;
-                        % We don't have the typeclass_info as a parameter to
-                        % the pred, so we must be able to create it from
-                        % somewhere else
+                        % We don't have the typeclass_info, we must either have
+                        % a proof that tells us how to make it, or it will be
+                        % produced by an existentially typed goal that we
+                        % will process later on.
 
-                        % Work out how to make it
-                map__lookup(Proofs, Constraint, Proof),
+                map__search(Info0^proof_map, Constraint, Proof)
+        ->
+                polymorphism__make_typeclass_info_from_proof(Constraint, Proof,
+                        ExistQVars, Context, MaybeVar, ExtraGoals0, ExtraGoals,
+                        Info0, Info)
+        ;
+                polymorphism__make_typeclass_info_head_var(Constraint,
+                        NewVar, Info0, Info1),
+                map__det_insert(Info1^typeclass_info_map, Constraint, NewVar,
+                        NewTypeClassInfoMap),
+                Info = (Info1^typeclass_info_map := NewTypeClassInfoMap),
+                MaybeVar = yes(NewVar),
+                ExtraGoals = ExtraGoals0
+        ).
+
+:- pred polymorphism__make_typeclass_info_from_proof(class_constraint,
+        constraint_proof, existq_tvars, prog_context, maybe(prog_var),
+        list(hlds_goal), list(hlds_goal), poly_info, poly_info).
+:- mode polymorphism__make_typeclass_info_from_proof(in, in, in, in, out, 
+        in, out, in, out) is det.
+
+polymorphism__make_typeclass_info_from_proof(Constraint, Proof, ExistQVars, 
+                Context, MaybeVar, ExtraGoals0, ExtraGoals, Info0, Info) :-
+        Info0 = poly_info(VarSet0, VarTypes0, TypeVarSet, TypeInfoMap0, 
+                TypeClassInfoMap0, Proofs, PredName, ModuleInfo),
+        Constraint = constraint(ClassName, ConstrainedTypes),
+        list__length(ConstrainedTypes, ClassArity),
+        ClassId = class_id(ClassName, ClassArity),
                 (
                                 % We have to construct the typeclass_info
                                 % using an instance declaration
@@ -2336,7 +2359,6 @@
 
                                 % Add it to the accumulator
                         ExtraGoals = [SuperClassGoal,IndexGoal|ExtraGoals1]
-                )
         ).
 
 :- pred polymorphism__construct_typeclass_info(list(prog_var), list(prog_var), 
@@ -3051,21 +3073,22 @@
                 is det.
 
 polymorphism__make_typeclass_info_head_vars(Constraints, ExtraHeadVars) -->
-        { ExtraHeadVars0 = [] },
-        polymorphism__make_typeclass_info_head_vars_2(Constraints,
-                ExtraHeadVars0, ExtraHeadVars1),
-        { list__reverse(ExtraHeadVars1, ExtraHeadVars) }.
-
-:- pred polymorphism__make_typeclass_info_head_vars_2(list(class_constraint),
-                list(prog_var), list(prog_var), poly_info, poly_info).
-:- mode polymorphism__make_typeclass_info_head_vars_2(in, in, out, in, out)
-                is det.
+        list__map_foldl(polymorphism__make_typeclass_info_head_var,
+                Constraints, ExtraHeadVars).
 
-polymorphism__make_typeclass_info_head_vars_2([],
-                ExtraHeadVars, ExtraHeadVars) --> [].
-polymorphism__make_typeclass_info_head_vars_2([C|Cs], 
-                ExtraHeadVars0, ExtraHeadVars, Info0, Info) :-
+:- pred polymorphism__make_typeclass_info_head_var(class_constraint,
+                prog_var, poly_info, poly_info).
+:- mode polymorphism__make_typeclass_info_head_var(in, out, in, out) is det.
+
+polymorphism__make_typeclass_info_head_var(C, ExtraHeadVar, Info0, Info) :-
 
+        poly_info_get_typeclass_info_map(Info0, TypeClassInfoMap),
+        (
+                map__search(TypeClassInfoMap, C, ExistingVar)
+        ->
+                ExtraHeadVar = ExistingVar,
+                Info = Info0
+        ;
         poly_info_get_varset(Info0, VarSet0),
         poly_info_get_var_types(Info0, VarTypes0),
         poly_info_get_type_info_map(Info0, TypeInfoMap0),
@@ -3083,57 +3106,57 @@
 
         unqualify_name(ClassName0, ClassName),
 
-                % Make a new variable to contain the dictionary for this
-                % typeclass constraint
+                        % Make a new variable to contain the dictionary for 
+                        % this typeclass constraint
         polymorphism__new_typeclass_info_var(VarSet0, VarTypes0, C,
-                ClassName, Var, VarSet1, VarTypes1),
-        ExtraHeadVars1 = [Var | ExtraHeadVars0],
+                        ClassName, ExtraHeadVar, VarSet1, VarTypes1),
 
-                % Find all the type variables in the constraint, and remember
-                % what index they appear in in the typeclass info.
+                        % Find all the type variables in the constraint, and
+                        % remember what index they appear in in the typeclass
+                        % info.
 
-                % The first type_info will be just after the superclass infos
+                        % The first type_info will be just after the superclass
+                        % infos
         First is NumSuperClasses + 1,
         term__vars_list(ClassTypes, ClassTypeVars0),
-        MakeIndex = lambda([Elem0::in, Elem::out, 
-                                Index0::in, Index::out] is det,
-                (
+                MakeIndex = (pred(Elem0::in, Elem::out, 
+                                        Index0::in, Index::out) is det :-
                         Elem = Elem0 - Index0,
                         Index is Index0 + 1,
-                        % the following call is a work-around for a compiler
-                        % bug with intermodule optimization: it is needed to
-                        % resolve a type ambiguity
+                                % the following call is a work-around for a
+                                % compiler bug with intermodule optimization: 
+                                % it is needed to resolve a type ambiguity
                         is_pair(Elem)
-                )),
-        list__map_foldl(MakeIndex, ClassTypeVars0, ClassTypeVars, First, _),
+                        ),
+                list__map_foldl(MakeIndex, ClassTypeVars0, ClassTypeVars, 
+                        First, _),
                 
 
                 % Work out which ones haven't been seen before
-        IsNew = lambda([TypeVar0::in] is semidet,
-                (
+                IsNew = (pred(TypeVar0::in) is semidet :-
                         TypeVar0 = TypeVar - _Index,
                         \+ map__search(TypeInfoMap0, TypeVar, _)
-                )),
+                        ),
         list__filter(IsNew, ClassTypeVars, NewClassTypeVars),
 
-                % Make an entry in the TypeInfo locations map for each new
-                % type variable. The type variable can be found at the
-                % previously calculated offset with the new typeclass_info
-        MakeEntry = lambda([IndexedTypeVar::in, 
-                                LocnMap0::in, LocnMap::out] is det,
-                (
+                        % Make an entry in the TypeInfo locations map for each
+                        % new type variable. The type variable can be found at
+                        % the previously calculated offset with the new
+                        % typeclass_info
+                MakeEntry = (pred(IndexedTypeVar::in, 
+                                        LocnMap0::in, LocnMap::out) is det :-
                         IndexedTypeVar = TheTypeVar - Location,
                         map__set(LocnMap0, TheTypeVar,
-                                typeclass_info(Var, Location), LocnMap)
-                )),
-        list__foldl(MakeEntry, NewClassTypeVars, TypeInfoMap0, TypeInfoMap1),
-
-        poly_info_set_varset_and_types(VarSet1, VarTypes1, Info0, Info1),
-        poly_info_set_type_info_map(TypeInfoMap1, Info1, Info2),
-
-                % Handle the rest of the constraints
-        polymorphism__make_typeclass_info_head_vars_2(Cs, 
-                ExtraHeadVars1, ExtraHeadVars, Info2, Info).
+                                        typeclass_info(ExtraHeadVar, Location),
+                                                LocnMap)
+                        ),
+                list__foldl(MakeEntry, NewClassTypeVars, TypeInfoMap0,
+                        TypeInfoMap1),
+
+                poly_info_set_varset_and_types(VarSet1, VarTypes1, Info0,
+                        Info1),
+                poly_info_set_type_info_map(TypeInfoMap1, Info1, Info)
+        ).
 
 :- pred is_pair(pair(_, _)::in) is det.
 is_pair(_).
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/staff/zs/imp/mercury/doc/reference_manual.texi,v
retrieving revision 1.201
diff -u -t -r1.201 reference_manual.texi
--- doc/reference_manual.texi	2001/01/11 09:34:21	1.201
+++ doc/reference_manual.texi	2001/02/08 03:06:03
@@ -4018,7 +4018,6 @@
 * Existential class constraints::
 * Existentially typed data types::
 * Some idioms using existentially quantified types::
-* Known bugs in the current implementation::
 @end menu
 
 @node Existentially typed predicates and functions
@@ -4406,30 +4405,6 @@
         ),
         Univ = mkshowable(Showable).
 @end example
-
- at node Known bugs in the current implementation
- at section Known bugs in the current implementation
-
-The current implementation does not properly deal with most cases
-that involve both existentially quantified constraints and
-mode reordering due to the modes of type variables.
-Note that this can easily arise if you're using nested function calls.
-The symptom in such cases is usually spurious mode errors,
-or sometimes internal compiler errors of the form
-
- at example
-Software error: map__lookup: key not found
-Key Type: prog_data:class_constraint
-Key Functor: constraint/2
-Value Type: hlds_data:constraint_proof
- at end example
-
- at noindent
-The work-around is to write such code in the correct order manually
-rather than relying on the compiler's mode reordering.
-For nested function calls, you may need to split them up using
-temporary variables, e.g. instead of @samp{X = f(g(Y))},
-write @samp{G = g(Y), X = f(G)}.
 
 @node Semantics
 @chapter Semantics
Index: tests/hard_coded/typeclasses/Mmakefile
===================================================================
RCS file: /home/staff/zs/imp/tests/hard_coded/typeclasses/Mmakefile,v
retrieving revision 1.43
diff -u -t -r1.43 Mmakefile
--- tests/hard_coded/typeclasses/Mmakefile	2001/01/15 07:27:28	1.43
+++ tests/hard_coded/typeclasses/Mmakefile	2001/02/06 04:11:43
@@ -42,6 +42,7 @@
         nondet_class_method \
         operator_classname \
         record_syntax \
+        reordered_existential_constraint \
         superclass_bug \
         superclass_bug2 \
         superclass_call \

New File: tests/hard_coded/typeclasses/reordered_existential_constraint.exp
===================================================================
Hi!

New File: tests/hard_coded/typeclasses/reordered_existential_constraint.m
===================================================================

:- module reordered_existential_constraint.

:- interface.

:- import_module io.

:- pred main(io__state::di, io__state::uo) is det.

:- implementation.

main --> { foobar }, io__write_string("Hi!\n").

:- typeclass c(T) where [].

:- instance c(int) where [].

%:- pred q(T).
:- pred q(T) <= c(T).
:- mode q(in) is det.

q(_).

%:- some [T] pred p(T).
:- some [T] pred p(T) => c(T).
:- mode p(out) is det.

p(1).

:- pred foobar is det.

foobar :-
	q(X),	% XXX polymorphism aborts here, looking for the variable that
		% contains the type class info for c(T).
	p(X).



dgj
-- 
David Jeffery (dgj at cs.mu.oz.au) | If your thesis is utterly vacuous
PhD student,                    | Use first-order predicate calculus.
Dept. of Comp. Sci. & Soft. Eng.|     With sufficient formality
The University of Melbourne     |     The sheerist banality
Australia                       | Will be hailed by the critics: "Miraculous!"
                                |     -- Anon.
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------



More information about the developers mailing list