[m-rev.] diff: fix typechecking loop

[Mark Brown]

Hi,

This fixes the bug reported by Peter Ross.

Cheers,
Mark.

Estimated hours taken: 4
Branches: main

compiler/typeclasses.m:
	Fix a bug which could cause non-termination during context
	reduction.

tests/valid/Mercury.options:
tests/valid/Mmakefile:
tests/valid/time_yaowl.m:
	Test case.

Index: compiler/typeclasses.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typeclasses.m,v
retrieving revision 1.19
diff -u -r1.19 typeclasses.m
--- compiler/typeclasses.m	1 Dec 2006 15:04:27 -0000	1.19
+++ compiler/typeclasses.m	27 Feb 2007 15:18:45 -0000
@@ -443,7 +443,11 @@
         % since we have partitioned them already.
         subsumes_on_elements(Domain, InstanceTypes0, ConstraintTypes, Subst),
         apply_rec_subst_to_type_list(Subst, InstanceTypes0, InstanceTypes),
-        \+ lists_match_on_elements(Range, InstanceTypes, ConstraintTypes),
+
+        % Improvement occurs iff the instance range types are not more
+        % general than the constraint range types.  If they *are* more
+        % general, we stop here.
+        \+ subsumes_on_elements(Range, InstanceTypes, ConstraintTypes, _),
 
         % The unification can fail if type parameters in the declaration
         % would be bound by the improvement rule. This means that the
Index: tests/valid/Mercury.options
===================================================================
RCS file: /home/mercury1/repository/tests/valid/Mercury.options,v
retrieving revision 1.33
diff -u -r1.33 Mercury.options
--- tests/valid/Mercury.options	20 Dec 2006 04:31:51 -0000	1.33
+++ tests/valid/Mercury.options	27 Feb 2007 15:18:45 -0000
@@ -92,6 +92,7 @@
 MCFLAGS-solv			= --halt-at-warn
 MCFLAGS-spurious_purity_warning	= --halt-at-warn
 MCFLAGS-stack_opt_simplify	= --optimize-saved-vars
+MCFLAGS-time_yaowl		= --allow-stubs
 MCFLAGS-tuple_eqv               = --smart-recompilation
 MCFLAGS-two_way_unif		= -O-1
 MCFLAGS-typeclass_det_warning	= --halt-at-warn
Index: tests/valid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/valid/Mmakefile,v
retrieving revision 1.185
diff -u -r1.185 Mmakefile
--- tests/valid/Mmakefile	10 Jan 2007 16:28:21 -0000	1.185
+++ tests/valid/Mmakefile	27 Feb 2007 15:18:45 -0000
@@ -41,6 +41,7 @@
 	superclass_bug \
 	superclass_improvement \
 	tc_map_lookup \
+	time_yaowl \
 	typeclass_constraint_no_var \
 	typeclass_constraint_nonvar_bug \
 	typeclass_det_warning
Index: tests/valid/time_yaowl.m
===================================================================
RCS file: tests/valid/time_yaowl.m
diff -N tests/valid/time_yaowl.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/valid/time_yaowl.m	27 Feb 2007 15:18:45 -0000
@@ -0,0 +1,61 @@
+:- module time_yaowl.
+
+:- interface.
+
+:- import_module io.
+
+%------------------------------------------------------------------------------%
+:- type time_global(G).
+:- type time_static(S) ---> time_static(S).
+:- type time_token(T).
+:- type time_state_holder(StateHolder).
+
+:- pred build_time_yaowl_specification(S::in, 
+                        yaowl_specification(time_global(G), time_token(T))::out, io::di, io::uo) is det
+                        <= (yaowl_static_global_token(S, G, T)).
+
+%------------------------------------------------------------------------------%
+%------------------------------------------------------------------------------%
+:- implementation.
+
+:- import_module time.
+
+%------------------------------------------------------------------------------%
+
+build_time_yaowl_specification(S, WF, !IO) :-
+    build_specification(time_static(S), WF, !IO).
+
+%------------------------------------------------------------------------------%
+
+:- instance yaowl_static_global_token(time_static(S), time_global(G), time_token(T)) 
+    <= yaowl_static_global_token(S, G, T) where [].
+
+%------------------------------------------------------------------------------%
+
+:- type time_global(G)	--->
+            time_global(
+                tg_global          :: G,
+                tg_time            :: tm
+            ).
+
+:- type time_token(T)	--->
+            time_token(
+                tt_token           :: T,
+                tt_time            :: time_t
+            ).
+
+:- type time_state_holder(StateHolder) ---> time_state_holder(StateHolder).
+
+%------------------------------------------------------------------------------%
+
+:- pred build_specification(S::in, yaowl_specification(G, T)::out, io::di, io::uo) is det
+                              <= (yaowl_static_global_token(S, G, T)).
+
+:- typeclass yaowl_static_global_token(S, G, T) <= ((S -> G)) where [].
+
+:- type yaowl_specification(G, T)
+        --->
+            yaowl_specification(
+                G, T
+            ).
+
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------