[m-rev.] for review: Fix bug 271.

[Paul Bone]

For review by Zoltan.

Branches: main, 12.08

Thense changes are waiting in github as pull requests for both the master and
release branches.

Zoltan, could you check my understanding of the role of the existential
veriables list in this code.  Or explain under shat situations my understanding
does not work.

commit 73090d97420bd7c758bb35b59a130767c1729fc7
Author: Paul Bone <paul at bone.id.au>
Date:   Fri Jan 4 11:36:10 2013 +1100

    Fix bug 271.

    Bug271 is caused by the handling of multiple typeclass infos for the same
    type where existentially typed variables are also present.  When the
    compiler knows that a typeclass info value is a constant it is allocated
    statically on backends that support this.  When the typeclass info value is
    seen a second time (on any execution path) the previously created static
    value is used for the typeclass info.  However, if a predicate call's
    arguments include both a constrained universally quantified variable, and an
    existentially quantified variable, then polymorphism.m attempts to create a
    new value, regardless of whether there is an existing value.  When it
    records the new value in the table of constant typeclass instance values, it
    crashes as this key is already present.

    This change allows the constant typeclass instance value to be reused if
    it where present, by removing the test of the presence of existentially
    typed variables.

    compiler/polymorphism.m:
        As above.

ommit fefe868097437671bdd633adc74c96fdd6a458d9
Author: Paul Bone <paul at bone.id.au>
Date:   Fri Jan 4 11:34:01 2013 +1100

    Add a test case for bug 271.

    The bug results in a compiler crash when the compiler constructs a
    typeclass info variable that it has already constructed on another branch
    and there is also an existentially quantified variable present.

    tests/valid/bug271.m:
    tests/valid/Mmakefile:
    tests/valid/Mercury.options:
        As above.

diff --git a/compiler/polymorphism.m b/compiler/polymorphism.m
index 96bc248..614e333 100644
--- a/compiler/polymorphism.m
+++ b/compiler/polymorphism.m
@@ -2659,7 +2659,6 @@ make_typeclass_info_from_instance(Constraint, Seen, InstanceNum, ExistQVars,
     poly_info_get_const_struct_db(!.Info, ConstStructDb0),
     InstanceId = ciid(InstanceNum, Constraint, Seen),
     (
-        ExistQVars = [],
         search_for_constant_instance(ConstStructDb0, InstanceId,
             InstanceIdConstNum)
     ->
diff --git a/tests/valid/Mercury.options b/tests/valid/Mercury.options
index c50d775..590209f 100644
--- a/tests/valid/Mercury.options
+++ b/tests/valid/Mercury.options
@@ -47,6 +47,7 @@ MCFLAGS-bug134                  = --no-static-ground-terms --no-optimize-dead-pr
 MCFLAGS-bug142                  = --optimise-higher-order --inline-single-use
 MCFLAGS-bug159                  = -w
 MCFLAGS-bug180                  = --profile-optimized --allow-stubs --no-warn-stubs
+MCFLAGS-bug271                  = --allow-stubs --no-warn-stubs
 MCFLAGS-compl_unify_bug		= -O3
 MCFLAGS-constraint_prop_bug	= -O0 --common-struct --local-constraint-propagation
 MCFLAGS-csharp_hello		= --no-intermodule-optimization
diff --git a/tests/valid/Mmakefile b/tests/valid/Mmakefile
index c6f08b8..f87c397 100644
--- a/tests/valid/Mmakefile
+++ b/tests/valid/Mmakefile
@@ -19,6 +19,7 @@ TRAIL_PROGS= \

 TYPECLASS_PROGS= \
 	abstract_typeclass \
+	bug271 \
 	complex_constraint \
 	exists_bug \
 	exists_fundeps \
diff --git a/tests/valid/bug271.m b/tests/valid/bug271.m
new file mode 100644
index 0000000..dfe9f83
--- /dev/null
+++ b/tests/valid/bug271.m
@@ -0,0 +1,61 @@
+
+:- module bug271.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module int.
+:- import_module list.
+:- import_module string.
+
+:- type a_or_b
+    --->    a
+    ;       b.
+
+main(!IO) :-
+    get_a_or_b(AB),
+    (
+        AB = a,
+        obj_to_num(obj, X),
+        S = to_string(X)
+    ;
+        AB = b,
+        obj_to_num(obj, X),
+        S = to_string(X)
+    ),
+    format("%s\n", [s(S)], !IO).
+
+:- pred get_a_or_b(a_or_b::out) is det.
+
+:- typeclass literal(X) where [
+    func literal_type(X) = literal_type
+].
+
+:- typeclass num(X) where [
+    func to_string(X) = string
+].
+
+:- some [Y] (pred obj_to_num(object(X)::in, Y::out) is det => num(Y)) <= literal(X).
+
+% We need a clause so that Y gets a type assignment.
+obj_to_num(_, 15).
+
+:- type object(L) --->
+    object(L).
+:- type literal ---> literal.
+:- type literal_type ---> literal_type.
+:- func obj = object(literal).
+
+:- instance literal(literal) where [
+    (literal_type(literal) = literal_type)
+].
+
+:- instance num(int) where [
+    (to_string(X) = string(X))
+].
+

-- 
Paul Bone
http://www.bone.id.au
-------------- next part --------------
A non-text attachment was scrubbed...
Name: signature.asc
Type: application/pgp-signature
Size: 835 bytes
Desc: Digital signature
URL: <http://lists.mercurylang.org/archives/reviews/attachments/20130104/220be1fd/attachment.sig>