[m-rev.] diff: generate errors for abstract eqv types in instances

Zoltan Somogyi zs at unimelb.edu.au
Wed Jun 6 01:13:32 AEST 2012


This diff includes the diff I previously posted, since I forgot to actually
commit that diff :-(

Julien has already reviewed the idea of the diff, and the implementation is
relatively straightforward.

Zoltan.

Gneerate an error message for instance definitions that specify a type
that is an abstract exported equivalence type.

compiler/prog_item.m:
compiler/hlds_data.m:
	Add fields to the parse tree and HLDS representations of instance
	definitions to preserve the original types they contain.

compiler/prog_io_typeclass.m:
	When creating instance definitions, duplicate the type field.

compiler/add_class.m:
compiler/make_hlds_passes.m:
	Copy the field from the parse tree to the HLDS.

compiler/equiv_type.m:
	When replacing equivalence types in instance definitions, leave
	unchanged the copies of the original types in the new field.

	This expansion is done BEFORE we construct the item list we convert
	to the HLDS. The complete erasure of the original types done by
	previous versions of the compiler is why those versions couldn't
	generate the error messages generated by this diff.

compiler/check_typeclass.m:
	Generate the error message in circumstances that call for it.
	In this error message, mention the types the user wrote, not
	the expanded types.

	Also do several kinds of cleanups.

        First, this modules does several different checks. Put the code that
        does those checks in the same order as the comment at the top
        explaining them, and the order in which they are executed.

        Second, give some predicates and variables more meaningful names.

        Third, fix the error messages so that they form complete sentences,
        and do not use abbreviations unnecessarily.

compiler/hlds_out_module.m:
	Print out the new field.

compiler/base_typeclass_info.m:
compiler/dead_proc_elim.m:
compiler/higher_order.m:
compiler/intermod.m:
compiler/mercury_to_mercury.m:
compiler/module_qual.m:
compiler/polymorphism.m:
compiler/recompilation.usage.m:
compiler/recompilation.version.m:
	Ignore the extra field, or copy it unchanged.

tests/invalid/constraint_proof_bug_lib.{m,err_exp}:
	A test case for this diff. This module is a copy of
	tests/valid/constraint_proof_bug_lib.m with cleaned-up syntax.
	This module has an instance definition for an abstract exported
	equivalence type.

tests/invalid/Mmakefile:
	Enable the new test case.

tests/invalid/bad_instance.err_exp:
tests/invalid/instance_dup_var.err_exp:
tests/invalid/instance_var_bug.err_exp:
tests/invalid/invalid_instance_declarations.err_exp:
tests/invalid/invalid_typeclass.err_exp:
	Update the expected error messages for the third cleanup change above.

tests/valid/Mmakefile:
	Disable the constraint_proof_bug test case, since its
	constraint_proof_bug_lib.m module has the bug we now test for.
	The only reason why the test case ever passed (why the bug
	was not caught at link time, as it was designed to be caught)
	is that the code in constraint_proof_bug.m that needs the bad instance
	definition is dead code, and is eliminated as such.

tests/invalid/constraint_proof_bug_lib.m:
	Adopt the cleanup from the copy in the invalid directory.

cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/extra
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/extra
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/libatomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops/doc
cvs diff: Diffing boehm_gc/libatomic_ops/src
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/armcc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops/tests
cvs diff: Diffing boehm_gc/libatomic_ops-1.2
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/doc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/tests
cvs diff: Diffing boehm_gc/m4
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/add_class.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_class.m,v
retrieving revision 1.39
diff -u -b -r1.39 add_class.m
--- compiler/add_class.m	16 Aug 2011 03:26:29 -0000	1.39
+++ compiler/add_class.m	5 Jun 2012 15:05:13 -0000
@@ -27,8 +27,8 @@
     list(error_spec)::in, list(error_spec)::out) is det.
 
 :- pred module_add_instance_defn(module_name::in, list(prog_constraint)::in,
-    sym_name::in, list(mer_type)::in, instance_body::in, tvarset::in,
-    import_status::in, prog_context::in,
+    sym_name::in, list(mer_type)::in, list(mer_type)::in, instance_body::in,
+    tvarset::in, import_status::in, prog_context::in,
     module_info::in, module_info::out,
     list(error_spec)::in, list(error_spec)::out) is det.
 
@@ -183,9 +183,8 @@
 
         (
             IsNewDefn = yes,
-
-                % When we find the class declaration, make an
-                % entry for the instances.
+            % When we find the class declaration, make an entry
+            % for the instances.
             module_info_get_instance_table(!.ModuleInfo, Instances0),
             map.det_insert(ClassId, [], Instances0, Instances),
             module_info_set_instance_table(Instances, !ModuleInfo)
@@ -448,7 +447,8 @@
     check_method_modes(Methods, !PredProcIds, !ModuleInfo, !Specs).
 
 module_add_instance_defn(InstanceModuleName, Constraints, ClassName,
-        Types, Body0, VarSet, Status, Context, !ModuleInfo, !Specs) :-
+        Types, OriginalTypes, Body0, VarSet, Status, Context,
+        !ModuleInfo, !Specs) :-
     module_info_get_class_table(!.ModuleInfo, Classes),
     module_info_get_instance_table(!.ModuleInfo, Instances0),
     list.length(Types, ClassArity),
@@ -457,7 +457,8 @@
     ( map.search(Classes, ClassId, _) ->
         map.init(Empty),
         NewInstanceDefn = hlds_instance_defn(InstanceModuleName, Status,
-            Context, Constraints, Types, Body, no, VarSet, Empty),
+            Context, Constraints, Types, OriginalTypes, Body, no,
+            VarSet, Empty),
         map.lookup(Instances0, ClassId, InstanceDefns),
 
         check_for_overlapping_instances(NewInstanceDefn, InstanceDefns,
@@ -481,11 +482,11 @@
         !Specs) :-
     IsOverlapping = (pred((Context - OtherContext)::out) is nondet :-
         NewInstanceDefn = hlds_instance_defn(_, _Status, Context,
-            _, Types, Body, _, VarSet, _),
+            _, Types, _, Body, _, VarSet, _),
         Body = instance_body_concrete(_), % XXX
         list.member(OtherInstanceDefn, InstanceDefns),
         OtherInstanceDefn = hlds_instance_defn(_, _OtherStatus,
-            OtherContext, _, OtherTypes, OtherBody, _, OtherVarSet, _),
+            OtherContext, _, OtherTypes, _, OtherBody, _, OtherVarSet, _),
         OtherBody = instance_body_concrete(_), % XXX
         tvarset_merge_renaming(VarSet, OtherVarSet, _NewVarSet, Renaming),
         apply_variable_renaming_to_type_list(Renaming, OtherTypes,
Index: compiler/base_typeclass_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/base_typeclass_info.m,v
retrieving revision 1.53
diff -u -b -r1.53 base_typeclass_info.m
--- compiler/base_typeclass_info.m	23 May 2011 05:08:00 -0000	1.53
+++ compiler/base_typeclass_info.m	5 Jun 2012 15:05:13 -0000
@@ -90,7 +90,7 @@
     gen_infos_for_instance_list(ClassId - Is, ModuleName, ModuleInfo,
         !RttiDataList),
     InstanceDefn = hlds_instance_defn(InstanceModule, ImportStatus,
-        _TermContext, InstanceConstraints, InstanceTypes, Body,
+        _TermContext, InstanceConstraints, InstanceTypes, _OriginalTypes, Body,
         PredProcIds, _Varset, _SuperClassProofs),
     (
         Body = instance_body_concrete(_),
Index: compiler/check_typeclass.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/check_typeclass.m,v
retrieving revision 1.141
diff -u -b -r1.141 check_typeclass.m
--- compiler/check_typeclass.m	4 Jun 2012 08:35:05 -0000	1.141
+++ compiler/check_typeclass.m	5 Jun 2012 15:05:15 -0000
@@ -16,9 +16,14 @@
 % in the instance declaration is either a type with no arguments,
 % or a polymorphic type whose arguments are all distinct type variables.
 % We also check that all of the types in exported instance declarations are
-% in scope here. XXX the latter part should really be done earlier, but with
+% in scope here. XXX The latter part should really be done earlier, but with
 % the current implementation this is the most convenient spot.
 %
+% This step also checks that types in instance declarations are not abstract
+% exported equivalence types defined in this module. Unfortunately, there is
+% no way to check at compile time that it is not an abstract exported
+% equivalence type defined in some *other* module.
+%
 % (2) In check_instance_decls/6, for every method of every instance we
 % generate a new pred whose types and modes are as expected by the typeclass
 % declaration, and whose body just calls the implementation provided by the
@@ -227,10 +232,63 @@
 
 check_instance_declaration_types_for_instance(ModuleInfo,
         ClassId, InstanceDefn, !Specs) :-
+    OriginalTypes = InstanceDefn ^ instance_orig_types,
+    list.foldl2(is_valid_instance_orig_type(ModuleInfo, ClassId, InstanceDefn),
+        OriginalTypes, 1, _, !Specs),
     Types = InstanceDefn ^ instance_types,
     list.foldl3(is_valid_instance_type(ModuleInfo, ClassId, InstanceDefn),
         Types, 1, _, set.init, _, !Specs).
 
+:- pred is_valid_instance_orig_type(module_info::in,
+    class_id::in, hlds_instance_defn::in, mer_type::in,
+    int::in, int::out, list(error_spec)::in, list(error_spec)::out) is det.
+
+is_valid_instance_orig_type(ModuleInfo, ClassId, InstanceDefn, Type,
+        N, N+1, !Specs) :-
+    (
+        Type = defined_type(_TypeName, _, _),
+        ( type_to_type_defn(ModuleInfo, Type, TypeDefn) ->
+            get_type_defn_body(TypeDefn, TypeBody),
+            (
+                TypeBody = hlds_eqv_type(_),
+                get_type_defn_status(TypeDefn, TypeDefnStatus),
+                (
+                    TypeDefnStatus = status_abstract_exported,
+                    % If the instance definition is itself abstract exported,
+                    % we want to generate only one error message, instead of
+                    % two error messages, one for the abstract and one for the
+                    % concrete instance definition.
+                    InstanceDefn ^ instance_body = instance_body_concrete(_)
+                ->
+                    Spec = abstract_eqv_instance_type_msg(ClassId,
+                        InstanceDefn, N),
+                    !:Specs = [Spec | !.Specs]
+                ;
+                    true
+                )
+            ;
+                ( TypeBody = hlds_du_type(_, _, _, _, _, _, _, _, _)
+                ; TypeBody = hlds_foreign_type(_)
+                ; TypeBody = hlds_solver_type(_, _)
+                ; TypeBody = hlds_abstract_type(_)
+                )
+            )
+        ;
+            % The type is either a builtin type or a type variable.
+            true
+        )
+    ;
+        ( Type = builtin_type(_)
+        ; Type = higher_order_type(_, _, _, _)
+        ; Type = apply_n_type(_, _, _)
+        ; Type = type_variable(_, _)
+        ; Type = tuple_type(_, _)
+        )
+    ;
+        Type = kinded_type(_, _),
+        unexpected("check_typeclass", "kinded_type")
+    ).
+
     % Each of these types in the instance declaration must be either
     % (a) a type with no arguments, or (b) a polymorphic type whose arguments
     % are all distinct type variables.
@@ -255,8 +313,8 @@
             Type = type_variable(_, _),
             EndPieces = [words("is a type variable.")]
         ),
-        Spec = badly_formed_instance_type_msg_2(ClassId, InstanceDefn,
-            N, EndPieces),
+        Spec = bad_instance_type_msg(ClassId, InstanceDefn, N, EndPieces,
+            badly_formed),
         !:Specs = [Spec | !.Specs]
     ;
         Type = tuple_type(Args, _),
@@ -415,36 +473,62 @@
         EndPieces = [words("is a type whose"), nth_fixed(ArgNum),
             words("argument is not a variable.")]
     ),
-    Spec = badly_formed_instance_type_msg_2(ClassId, InstanceDefn,
-        N, EndPieces).
+    Spec = bad_instance_type_msg(ClassId, InstanceDefn, N, EndPieces,
+        badly_formed).
+
+:- func abstract_eqv_instance_type_msg(class_id, hlds_instance_defn, int) =
+    error_spec.
+
+abstract_eqv_instance_type_msg(ClassId, InstanceDefn, N) = Spec :-
+    EndPieces = [words("is an abstract exported equivalence type.")],
+    Spec = bad_instance_type_msg(ClassId, InstanceDefn, N, EndPieces,
+        abstract_exported_eqv).
 
-:- func badly_formed_instance_type_msg_2(class_id, hlds_instance_defn, int,
-    list(format_component)) = error_spec.
+:- type bad_instance_type_kind
+    --->    badly_formed
+    ;       abstract_exported_eqv.
 
-badly_formed_instance_type_msg_2(ClassId, InstanceDefn, N, EndPieces) = Spec :-
+:- func bad_instance_type_msg(class_id, hlds_instance_defn, int,
+    list(format_component), bad_instance_type_kind) = error_spec.
+
+bad_instance_type_msg(ClassId, InstanceDefn, N, EndPieces, Kind) = Spec :-
     ClassId = class_id(ClassName, _),
     ClassNameString = sym_name_to_string(ClassName),
 
     InstanceVarSet = InstanceDefn ^ instance_tvarset,
-    InstanceTypes = InstanceDefn ^ instance_types,
     InstanceContext = InstanceDefn ^ instance_context,
+    (
+        Kind = badly_formed,
+        % We are generating the error message because the type is badly
+        % formed as expanted. The unexpanded version may be correctly
+        % formed.
+        InstanceTypes = InstanceDefn ^ instance_types
+    ;
+        Kind = abstract_exported_eqv,
+        % Messages about the expanded type being an equivalence type
+        % would not make sense.
+        InstanceTypes = InstanceDefn ^ instance_orig_types
+    ),
     InstanceTypesString = mercury_type_list_to_string(InstanceVarSet,
         InstanceTypes),
 
-    HeaderPieces =
-        [words("In instance declaration for"),
-        words("`" ++ ClassNameString ++
-            "(" ++ InstanceTypesString ++ ")':")
-        ],
+    HeaderPieces = [words("In instance declaration for"),
+        words("`" ++ ClassNameString ++ "(" ++ InstanceTypesString ++ ")':")],
     ArgNumPieces = [words("the"), nth_fixed(N), words("argument") | EndPieces]
         ++ [nl],
+    (
+        Kind = abstract_exported_eqv,
+        HeadingMsg = simple_msg(InstanceContext,
+            [always(HeaderPieces), always(ArgNumPieces)])
+    ;
+        Kind = badly_formed,
     VerbosePieces =
         [words("(Types in instance declarations must be functors " ++
             "with distinct variables as arguments.)"), nl],
-
     HeadingMsg = simple_msg(InstanceContext,
         [always(HeaderPieces), always(ArgNumPieces),
-        verbose_only(VerbosePieces)]),
+            verbose_only(VerbosePieces)])
+    ),
     Spec = error_spec(severity_error, phase_type_check, [HeadingMsg]).
 
 %---------------------------------------------------------------------------%
@@ -525,7 +609,7 @@
         ClassInterface, ClassVarSet, PredIds, !InstanceDefn,
         !ModuleInfo, !QualInfo, !Specs):-
     % Check conformance of the instance body.
-    !.InstanceDefn = hlds_instance_defn(_, _, TermContext, _, _,
+    !.InstanceDefn = hlds_instance_defn(_, _, TermContext, _, _, _,
         InstanceBody, _, _, _),
     (
         InstanceBody = instance_body_abstract
@@ -731,7 +815,7 @@
             ModesAndDetism = modes_and_detism(Modes, InstVarSet, MaybeDetism)
         ), ProcIds, ArgModes),
 
-    InstanceDefn0 = hlds_instance_defn(_, Status, _, _, InstanceTypes,
+    InstanceDefn0 = hlds_instance_defn(_, Status, _, _, InstanceTypes, _,
         _, _, _, _),
 
     % Work out the name of the predicate that we will generate
@@ -771,7 +855,7 @@
         InstanceDefn0, InstanceDefn, OrderedInstanceMethods0,
         OrderedInstanceMethods, !Info, !Specs) :-
     InstanceDefn0 = hlds_instance_defn(InstanceModuleName, _InstanceStatus,
-        _InstanceContext, InstanceConstraints, InstanceTypes,
+        _InstanceContext, InstanceConstraints, InstanceTypes, _OriginalTypes,
         InstanceBody, MaybeInstancePredProcs, InstanceVarSet, _InstanceProofs),
     !.Info = instance_method_info(_ModuleInfo, _QualInfo, _PredName, Arity,
         _ExistQVars, _ArgTypes, _ClassContext, _ArgModes, _ArgTypeVars,
@@ -1037,9 +1121,9 @@
 
 check_superclass_conformance(ClassId, ProgSuperClasses0, ClassVars0,
         ClassVarSet, ModuleInfo, InstanceDefn0, InstanceDefn, !Specs) :-
-
-    InstanceDefn0 = hlds_instance_defn(A, B, Context, InstanceProgConstraints,
-        InstanceTypes, F, G, InstanceVarSet0, Proofs0),
+    InstanceDefn0 = hlds_instance_defn(ModuleName, Status, Context,
+        InstanceProgConstraints, InstanceTypes, OriginalTypes,
+        Body, Interface, InstanceVarSet0, Proofs0),
     tvarset_merge_renaming(InstanceVarSet0, ClassVarSet, InstanceVarSet1,
         Renaming),
 
@@ -1080,9 +1164,9 @@
 
     (
         UnprovenConstraints = [],
-        InstanceDefn = hlds_instance_defn(A, B, Context,
-            InstanceProgConstraints, InstanceTypes, F, G,
-            InstanceVarSet2, Proofs1)
+        InstanceDefn = hlds_instance_defn(ModuleName, Status, Context,
+            InstanceProgConstraints, InstanceTypes, OriginalTypes,
+            Body, Interface, InstanceVarSet2, Proofs1)
     ;
         UnprovenConstraints = [_ | UnprovenConstraintsTail],
         ClassId = class_id(ClassName, _ClassArity),
@@ -1835,7 +1919,6 @@
     words("See the ""Functional dependencies"" section"),
     words("of the reference manual for details."), nl].
 
-
 %---------------------------------------------------------------------------%
 
     % Check that all types appearing in universal (existential) constraints are
Index: compiler/dead_proc_elim.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dead_proc_elim.m,v
retrieving revision 1.143
diff -u -b -r1.143 dead_proc_elim.m
--- compiler/dead_proc_elim.m	13 Feb 2012 00:11:35 -0000	1.143
+++ compiler/dead_proc_elim.m	5 Jun 2012 15:05:16 -0000
@@ -277,7 +277,7 @@
     is det.
 
 get_instance_pred_procs(Instance, !Queue, !Needed) :-
-    Instance = hlds_instance_defn(_, _, _, _, _, _, PredProcIds, _, _),
+    Instance = hlds_instance_defn(_, _, _, _, _, _, _, PredProcIds, _, _),
     % We need to keep the instance methods for all instances
     % for optimization of method lookups.
     (
Index: compiler/equiv_type.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/equiv_type.m,v
retrieving revision 1.96
diff -u -b -r1.96 equiv_type.m
--- compiler/equiv_type.m	13 Feb 2012 00:11:36 -0000	1.96
+++ compiler/equiv_type.m	5 Jun 2012 15:05:17 -0000
@@ -544,8 +544,8 @@
 
 replace_in_instance_info(ModuleName, Location, EqvMap, _EqvInstMap,
         Info0, Info, !RecompInfo, !UsedModules, []) :-
-    Info0 = item_instance_info(Constraints0, ClassName, Ts0, InstanceBody,
-        VarSet0, ContainingModuleName, Context, SeqNum),
+    Info0 = item_instance_info(Constraints0, ClassName, Types0, OriginalTypes,
+        InstanceBody, VarSet0, ContainingModuleName, Context, SeqNum),
     (
         ( !.RecompInfo = no
         ; ContainingModuleName = ModuleName
@@ -558,13 +558,15 @@
     replace_in_prog_constraint_list(Location, EqvMap,
         Constraints0, Constraints, VarSet0, VarSet1,
         UsedTypeCtors0, UsedTypeCtors1, !UsedModules),
-    replace_in_type_list_location_circ(Location, EqvMap, Ts0, Ts, _, _,
+    replace_in_type_list_location_circ(Location, EqvMap, Types0, Types, _, _,
         VarSet1, VarSet, UsedTypeCtors1, UsedTypeCtors, !UsedModules),
-    list.length(Ts0, Arity),
+    % We specifically do NOT expand equivalence types in OriginalTypes.
+    % If we did, that would defeat the purpose of the field.
+    list.length(Types0, Arity),
     ItemId = item_id(typeclass_item, item_name(ClassName, Arity)),
     finish_recording_expanded_items(ItemId, UsedTypeCtors, !RecompInfo),
-    Info = item_instance_info(Constraints, ClassName, Ts, InstanceBody,
-        VarSet, ContainingModuleName, Context, SeqNum).
+    Info = item_instance_info(Constraints, ClassName, Types, OriginalTypes,
+        InstanceBody, VarSet, ContainingModuleName, Context, SeqNum).
 
 :- pred replace_in_pragma_info(module_name::in, eqv_type_location::in,
     eqv_map::in, eqv_inst_map::in,
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.201
diff -u -b -r1.201 higher_order.m
--- compiler/higher_order.m	13 Feb 2012 00:11:39 -0000	1.201
+++ compiler/higher_order.m	5 Jun 2012 15:05:19 -0000
@@ -979,7 +979,7 @@
             map.lookup(Instances, ClassId, InstanceList),
             list.det_index1(InstanceList, Instance, InstanceDefn),
             InstanceDefn = hlds_instance_defn(_, _, _,
-                InstanceConstraints, InstanceTypes0, _,
+                InstanceConstraints, InstanceTypes0, _, _,
                 yes(ClassInterface), _, _),
             type_vars_list(InstanceTypes0, InstanceTvars),
             get_unconstrained_tvars(InstanceTvars,
@@ -1089,7 +1089,7 @@
 instance_matches(ClassTypes, Instance, Constraints, UnconstrainedTVarTypes,
         TVarSet0, TVarSet) :-
     Instance = hlds_instance_defn(_, _, _, Constraints0,
-        InstanceTypes0, _, _, InstanceTVarSet, _),
+        InstanceTypes0, _, _, _, InstanceTVarSet, _),
     tvarset_merge_renaming(TVarSet0, InstanceTVarSet, TVarSet, Renaming),
     apply_variable_renaming_to_type_list(Renaming, InstanceTypes0,
         InstanceTypes),
@@ -2027,7 +2027,7 @@
         map.lookup(Instances, ClassId, InstanceDefns),
         list.det_index1(InstanceDefns, InstanceNum, InstanceDefn),
         InstanceDefn = hlds_instance_defn(_, _, _, Constraints, InstanceTypes,
-            _, _, _, _),
+            _, _, _, _, _),
         (
             ( Manipulator = type_info_from_typeclass_info
             ; Manipulator = superclass_from_typeclass_info
Index: compiler/hlds_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_data.m,v
retrieving revision 1.143
diff -u -b -r1.143 hlds_data.m
--- compiler/hlds_data.m	18 Apr 2012 02:24:59 -0000	1.143
+++ compiler/hlds_data.m	5 Jun 2012 15:05:21 -0000
@@ -1327,8 +1327,10 @@
                 % Constraints on the instance declaration.
                 instance_constraints    :: list(prog_constraint),
 
-                % ClassTypes
+                % The class types. The original types field is used only
+                % for error checking.
                 instance_types          :: list(mer_type),
+                instance_orig_types     :: list(mer_type),
 
                 % Methods
                 instance_body           :: instance_body,
Index: compiler/hlds_out_module.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out_module.m,v
retrieving revision 1.11
diff -u -b -r1.11 hlds_out_module.m
--- compiler/hlds_out_module.m	23 Apr 2012 03:34:47 -0000	1.11
+++ compiler/hlds_out_module.m	5 Jun 2012 15:05:24 -0000
@@ -540,7 +540,8 @@
 
 write_instance_defn(Info, Indent, InstanceDefn, !IO) :-
     InstanceDefn = hlds_instance_defn(_InstanceModule, _Status,
-        Context, Constraints, Types, Body, MaybePredProcIds, VarSet, Proofs),
+        Context, Constraints, Types, OriginalTypes, Body,
+        MaybePredProcIds, VarSet, Proofs),
 
     term.context_file(Context, FileName),
     term.context_line(Context, LineNumber),
@@ -570,6 +571,10 @@
     io.write_string("% Types: ", !IO),
     io.write_list(Types, ", ", PrintTerm, !IO),
     io.nl(!IO),
+    write_indent(Indent, !IO),
+    io.write_string("% Original types: ", !IO),
+    io.write_list(OriginalTypes, ", ", PrintTerm, !IO),
+    io.nl(!IO),
 
     write_indent(Indent, !IO),
     io.write_string("% Constraints: ", !IO),
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.270
diff -u -b -r1.270 intermod.m
--- compiler/intermod.m	23 Apr 2012 03:34:48 -0000	1.270
+++ compiler/intermod.m	5 Jun 2012 15:05:26 -0000
@@ -316,7 +316,7 @@
         Arity = pred_info_orig_arity(PredInfo),
 
         % Predicates with `class_method' markers contain class_method_call
-        % goals which can't be written to `.opt' files (they can't be read
+        % goals which cannot be written to `.opt' files (they cannot be read
         % back in). They will be recreated in the importing module.
         pred_info_get_markers(PredInfo, Markers),
         \+ check_marker(Markers, marker_class_method),
@@ -508,7 +508,7 @@
     ;
         GoalExpr0 = call_foreign_proc(Attrs, _, _, _, _, _, _),
         GoalExpr = GoalExpr0,
-        % Inlineable exported pragma_foreign_code goals can't use any
+        % Inlineable exported pragma_foreign_code goals cannot use any
         % non-exported types, so we just write out the clauses.
         MaybeMayDuplicate = get_may_duplicate(Attrs),
         (
@@ -561,8 +561,8 @@
             ShortHand0 = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
                 MainGoal0, OrElseGoals0, OrElseInners),
             intermod_traverse_goal(MainGoal0, MainGoal, DoWrite1, !Info),
-            intermod_traverse_list_of_goals(OrElseGoals0, OrElseGoals, DoWrite2,
-                !Info),
+            intermod_traverse_list_of_goals(OrElseGoals0, OrElseGoals,
+                DoWrite2, !Info),
             bool.and(DoWrite1, DoWrite2, DoWrite),
             ShortHand = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
                 MainGoal, OrElseGoals, OrElseInners)
@@ -626,7 +626,7 @@
 add_proc(PredId, DoWrite, !Info) :-
     ( PredId = invalid_pred_id ->
         % This will happen for type class instance methods defined using
-        % the clause syntax. Currently we can't handle intermodule
+        % the clause syntax. Currently we cannot handle intermodule
         % optimization of those.
         DoWrite = no
     ;
@@ -674,10 +674,12 @@
         % Goals which call impure predicates cannot be written due to
         % limitations in mode analysis. The problem is that only head
         % unifications are allowed to be reordered with impure goals.
+        % For example,
         %
-        % e.g
         %   p(A::in, B::in, C::out) :- impure foo(A, B, C).
+        %
         % becomes
+        %
         %   p(HeadVar1, HeadVar2, HeadVar3) :-
         %       A = HeadVar1, B = HeadVar2, C = HeadVar3,
         %       impure foo(A, B, C).
@@ -689,9 +691,9 @@
         % in mode analysis would be tricky.
         % See tests/valid/impure_intermod.m.
         %
-        % NOTE: the above restriction applies to user predicates.  For
-        % the compiler generated mutable access predicates we can ensure
-        % that reordering is not necessary by construction, so it's safe
+        % NOTE: the above restriction applies to user predicates.
+        % For compiler generated mutable access predicates, we can ensure
+        % that reordering is not necessary by construction, so it is safe
         % to include them in .opt files.
 
         pred_info_get_purity(PredInfo, purity_impure),
@@ -699,8 +701,8 @@
     ->
         DoWrite = no
     ;
-        % If a pred whose code we're going to put in the .opt file calls
-        % a predicate which is exported, then we don't need to do anything
+        % If a pred whose code we are going to put in the .opt file calls
+        % a predicate which is exported, then we do not need to do anything
         % special.
 
         (
@@ -721,7 +723,7 @@
     ->
         DoWrite = yes
     ;
-        % If a pred whose code we're going to put in the `.opt' file calls
+        % If a pred whose code we are going to put in the `.opt' file calls
         % a predicate which is local to that module, then we need to put
         % the declaration for the called predicate in the `.opt' file.
 
@@ -777,14 +779,14 @@
             proc(PredId, _) = unshroud_pred_proc_id(ShroudedPredProcId),
             add_proc(PredId, DoWrite, !Info)
         ;
-            % It's an ordinary constructor, or a constant of a builtin type,
+            % It is an ordinary constructor, or a constant of a builtin type,
             % so just leave it alone.
             %
             % Constructors are module qualified by post_typecheck.m.
             %
             % Function calls and higher-order function applications
             % are transformed into ordinary calls and higher-order calls
-            % by post_typecheck.m, so they can't occur here.
+            % by post_typecheck.m, so they cannot occur here.
 
             DoWrite = yes
         )
@@ -810,8 +812,9 @@
     hlds_instance_defn::in, intermod_info::in, intermod_info::out) is det.
 
 gather_instances_3(ModuleInfo, ClassId, InstanceDefn, !Info) :-
-    InstanceDefn = hlds_instance_defn(A, Status, C, D, E, Interface0,
-        MaybePredProcIds, H, I),
+    InstanceDefn = hlds_instance_defn(ModuleName, Status, Context,
+        InstanceConstraints, Types, OriginalTypes, Interface0,
+        MaybePredProcIds, TVarSet, Proofs),
     DefinedThisModule = status_defined_in_this_module(Status),
     (
         DefinedThisModule = yes,
@@ -854,8 +857,8 @@
                 % cannot be written to the `.opt' file for any reason.
                 Interface = instance_body_abstract,
 
-                % Don't write declarations for any of the methods if one
-                % can't be written.
+                % Do not write declarations for any of the methods if one
+                % cannot be written.
                 !:Info = SaveInfo
             )
         ;
@@ -871,11 +874,12 @@
                 status_is_exported(Status) = no
             )
         ->
-            InstanceDefnToWrite = hlds_instance_defn(A, Status, C, D, E,
-                Interface, MaybePredProcIds, H, I),
+            InstanceDefnToWrite = hlds_instance_defn(ModuleName, Status,
+                Context, InstanceConstraints, Types, OriginalTypes,
+                Interface, MaybePredProcIds, TVarSet, Proofs),
             intermod_info_get_instances(!.Info, Instances0),
-            intermod_info_set_instances(
-                [ClassId - InstanceDefnToWrite | Instances0], !Info)
+            Instances = [ClassId - InstanceDefnToWrite | Instances0],
+            intermod_info_set_instances(Instances, !Info)
         ;
             true
         )
@@ -1035,8 +1039,8 @@
         hlds_data.get_type_defn_body(TypeDefn0, TypeBody0),
         (
             TypeBody0 = hlds_du_type(Ctors, Tags, CheaperTagTest, Enum,
-                MaybeUserEqComp0, MaybeDirectArgCtors, ReservedTag, ReservedAddr,
-                MaybeForeign0),
+                MaybeUserEqComp0, MaybeDirectArgCtors, ReservedTag,
+                ReservedAddr, MaybeForeign0),
             module_info_get_globals(ModuleInfo, Globals),
             globals.get_target(Globals, Target),
 
@@ -1067,8 +1071,8 @@
                 MaybeForeign = MaybeForeign0
             ),
             TypeBody = hlds_du_type(Ctors, Tags, CheaperTagTest, Enum,
-                MaybeUserEqComp, MaybeDirectArgCtors, ReservedTag, ReservedAddr,
-                MaybeForeign),
+                MaybeUserEqComp, MaybeDirectArgCtors, ReservedTag,
+                ReservedAddr, MaybeForeign),
             hlds_data.set_type_defn_body(TypeBody, TypeDefn0, TypeDefn)
         ;
             TypeBody0 = hlds_foreign_type(ForeignTypeBody0),
@@ -1480,7 +1484,8 @@
     ->
         map.foldl(gather_foreign_enum_value_pair, ConsTagVals, [],
             ForeignEnumVals),
-        ForeignPragma = pragma_foreign_enum(Lang, Name, Arity, ForeignEnumVals),
+        ForeignPragma = pragma_foreign_enum(Lang, Name, Arity,
+            ForeignEnumVals),
         ForeignItemPragma = item_pragma_info(user, ForeignPragma, Context, -1),
         ForeignItem = item_pragma(ForeignItemPragma),
         mercury_output_item(MercInfo, ForeignItem, !IO)
@@ -1627,10 +1632,10 @@
 
 intermod_write_instance(OutInfo, ClassId - InstanceDefn, !IO) :-
     InstanceDefn = hlds_instance_defn(ModuleName, _, Context, Constraints,
-        Types, Body, _, TVarSet, _),
+        Types, OriginalTypes, Body, _, TVarSet, _),
     ClassId = class_id(ClassName, _),
-    ItemInstance = item_instance_info(Constraints, ClassName, Types, Body,
-        TVarSet, ModuleName, Context, -1),
+    ItemInstance = item_instance_info(Constraints, ClassName,
+        Types, OriginalTypes, Body, TVarSet, ModuleName, Context, -1),
     Item = item_instance(ItemInstance),
     MercInfo = OutInfo ^ hoi_mercury_to_mercury,
     mercury_output_item(MercInfo, Item, !IO).
@@ -1654,8 +1659,8 @@
     pred_info_get_goal_type(PredInfo, GoalType),
     (
         GoalType = goal_type_foreign,
-        % For foreign code goals we can't append variable numbers to type
-        % variables in the predicate declaration because the foreign code
+        % For foreign code goals, we cannot append variable numbers to type
+        % variables in the predicate declaration, because the foreign code
         % may contain references to variables such as `TypeInfo_for_T'
         % which will break if `T' is written as `T_1' in the pred declaration.
         AppendVarNums = no
@@ -1778,8 +1783,8 @@
     prog_varset::in, list(prog_var)::in, pred_or_func::in, sym_name::in,
     maybe_vartypes::in, clause::in, io::di, io::uo) is det.
 
-intermod_write_clause(OutInfo, ModuleInfo, PredId, VarSet, HeadVars, PredOrFunc,
-        SymName, MaybeVarTypes, Clause0, !IO) :-
+intermod_write_clause(OutInfo, ModuleInfo, PredId, VarSet, HeadVars,
+        PredOrFunc, SymName, MaybeVarTypes, Clause0, !IO) :-
     Clause0 = clause(ApplicableProcIds, Goal, ImplLang, _, _),
     (
         ImplLang = impl_lang_mercury,
@@ -2305,12 +2310,12 @@
 
 adjust_instance_status_3(Instance0, Instance, !ModuleInfo) :-
     Instance0 = hlds_instance_defn(InstanceModule, Status0, Context,
-        Constraints, Types, Body, HLDSClassInterface,
-        TVarSet, ConstraintProofs),
+        Constraints, Types, OriginalTypes, Body,
+        HLDSClassInterface, TVarSet, ConstraintProofs),
     ( import_status_to_write(Status0) ->
         Instance = hlds_instance_defn(InstanceModule, status_exported,
-            Context, Constraints, Types, Body, HLDSClassInterface,
-            TVarSet, ConstraintProofs),
+            Context, Constraints, Types, OriginalTypes, Body,
+            HLDSClassInterface, TVarSet, ConstraintProofs),
         (
             HLDSClassInterface = yes(ClassInterface),
             class_procs_to_pred_ids(ClassInterface, PredIds),
Index: compiler/make_hlds_passes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make_hlds_passes.m,v
retrieving revision 1.118
diff -u -b -r1.118 make_hlds_passes.m
--- compiler/make_hlds_passes.m	13 Feb 2012 00:11:41 -0000	1.118
+++ compiler/make_hlds_passes.m	5 Jun 2012 15:05:28 -0000
@@ -1017,8 +1017,8 @@
     list(error_spec)::in, list(error_spec)::out) is det.
 
 add_pass_2_instance(ItemInstance, Status, !ModuleInfo, !Specs) :-
-    ItemInstance = item_instance_info(Constraints, Name, Types, Body, VarSet,
-        InstanceModuleName, Context, _SeqNum),
+    ItemInstance = item_instance_info(Constraints, Name, Types, OriginalTypes,
+        Body, VarSet, InstanceModuleName, Context, _SeqNum),
     Status = item_status(ImportStatus, _),
     (
         Body = instance_body_abstract,
@@ -1027,8 +1027,9 @@
         Body = instance_body_concrete(_),
         BodyStatus = ImportStatus
     ),
-    module_add_instance_defn(InstanceModuleName, Constraints, Name, Types,
-        Body, VarSet, BodyStatus, Context, !ModuleInfo, !Specs).
+    module_add_instance_defn(InstanceModuleName, Constraints, Name,
+        Types, OriginalTypes, Body, VarSet, BodyStatus, Context,
+        !ModuleInfo, !Specs).
 
 :- pred add_pass_2_initialise(item_initialise_info::in,
     item_status::in, module_info::in, module_info::out,
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.356
diff -u -b -r1.356 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m	23 Apr 2012 03:34:48 -0000	1.356
+++ compiler/mercury_to_mercury.m	5 Jun 2012 15:05:30 -0000
@@ -971,8 +971,12 @@
     io::di, io::uo) is det.
 
 mercury_output_item_instance(_, ItemInstance, !IO) :-
-    ItemInstance = item_instance_info(Constraints, ClassName, Types, Body,
-        VarSet, _InstanceModuleName, _Context, _SeqNum),
+    % XXX When prettyprinting a Mercury module, we want to print the original
+    % types. When generating interface types, we want to print the
+    % equiv-type-expanded types. We do the latter.
+    ItemInstance = item_instance_info(Constraints, ClassName,
+        Types, _OriginalTypes, Body, VarSet, _InstanceModuleName,
+        _Context, _SeqNum),
     io.write_string(":- instance ", !IO),
     % We put an extra set of brackets around the class name in case
     % the name is an operator.
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.190
diff -u -b -r1.190 module_qual.m
--- compiler/module_qual.m	23 Apr 2012 03:34:48 -0000	1.190
+++ compiler/module_qual.m	5 Jun 2012 15:05:31 -0000
@@ -884,8 +884,8 @@
         Continue = yes
     ;
         Item0 = item_instance(ItemInstance0),
-        ItemInstance0 = item_instance_info(Constraints0, Name0, Types0,
-            Body0, VarSet, ModName, Context, SeqNum),
+        ItemInstance0 = item_instance_info(Constraints0, Name0,
+            Types0, OriginalTypes0, Body0, VarSet, ModName, Context, SeqNum),
         list.length(Types0, Arity),
         Id = mq_id(Name0, Arity),
         mq_info_set_error_context(mqec_instance(Id) - Context, !Info),
@@ -900,10 +900,18 @@
         % us to resolve overloading.
         qualify_prog_constraint_list(Constraints0, Constraints, !Info, !Specs),
         qualify_class_name(Id, mq_id(Name, _), !Info, !Specs),
+        % XXX We don't want to keep the errors from the expansion of both
+        % forms of the instance types, since printing two error messages about
+        % one instance definition that make apparently contradictory
+        % assumptions about whether the instance types are equiv-type-expanded
+        % or not wouldd be confusing. However, I (zs) cannot think of any
+        % compelling reason right now for preferring the error messages
+        % from one version of the types over the other.
         qualify_type_list(Types0, Types, !Info, !Specs),
+        qualify_type_list(OriginalTypes0, OriginalTypes, !Info, !.Specs, _),
         qualify_instance_body(Name, Body0, Body),
-        ItemInstance = item_instance_info(Constraints, Name, Types,
-            Body, VarSet, ModName, Context, SeqNum),
+        ItemInstance = item_instance_info(Constraints, Name,
+            Types, OriginalTypes, Body, VarSet, ModName, Context, SeqNum),
         Item = item_instance(ItemInstance),
         Continue = yes
     ;
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.378
diff -u -b -r1.378 polymorphism.m
--- compiler/polymorphism.m	23 Apr 2012 03:34:48 -0000	1.378
+++ compiler/polymorphism.m	5 Jun 2012 15:05:33 -0000
@@ -2425,7 +2425,7 @@
     list.det_index1(InstanceList, InstanceNum, ProofInstanceDefn),
 
     ProofInstanceDefn = hlds_instance_defn(_, _, _, InstanceConstraints,
-        InstanceTypes, _, _, InstanceTVarset, InstanceProofs),
+        InstanceTypes, _, _, _, InstanceTVarset, InstanceProofs),
 
     % XXX kind inference:
     % we assume all tvars have kind `star'.
Index: compiler/prog_io_typeclass.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io_typeclass.m,v
retrieving revision 1.70
diff -u -b -r1.70 prog_io_typeclass.m
--- compiler/prog_io_typeclass.m	23 May 2011 05:08:10 -0000	1.70
+++ compiler/prog_io_typeclass.m	5 Jun 2012 15:05:34 -0000
@@ -665,12 +665,14 @@
             MaybeItemInstance = MaybeItemInstance0
         ;
             MaybeItemInstance0 = ok1(ItemInstance0),
-            ItemInstance0 = item_instance_info(_ConstraintList0, Name, Types,
-                Body, InstanceVarSet, ModName, InstanceContext, ItemSeqNum),
+            ItemInstance0 = item_instance_info(_ConstraintList0, Name,
+                Types, OriginalTypes, Body, InstanceVarSet, ModName,
+                InstanceContext, ItemSeqNum),
             % XXX Should we keep InstanceContext, or should we replace it
             % with Context? Or will they always be the same?
-            ItemInstance = item_instance_info(ConstraintList, Name, Types,
-                Body, InstanceVarSet, ModName, InstanceContext, ItemSeqNum),
+            ItemInstance = item_instance_info(ConstraintList, Name,
+                Types, OriginalTypes, Body, InstanceVarSet, ModName,
+                InstanceContext, ItemSeqNum),
             MaybeItemInstance = ok1(ItemInstance)
         )
     ;
@@ -705,7 +707,7 @@
         parse_types(TermTypes, VarSet, TypesContextPieces, MaybeTypes),
         (
             MaybeTypes = ok1(Types),
-            ItemInstance = item_instance_info([], ClassName, Types,
+            ItemInstance = item_instance_info([], ClassName, Types, Types,
                 instance_body_abstract, TVarSet, ModuleName, Context, SeqNum),
             MaybeItemInstance = ok1(ItemInstance)
         ;
@@ -736,10 +738,12 @@
             % XXX Should we keep InstanceContext, or should we replace it
             % with Context? Or will they always be the same?
             ItemInstance0 = item_instance_info(Constraints, NameString,
-                Types, _, _, ModName, InstanceContext, ItemSeqNum),
+                Types, OriginalTypes, _, _,
+                ModName, InstanceContext, ItemSeqNum),
             ItemInstance = item_instance_info(Constraints, NameString,
-                Types, instance_body_concrete(MethodList), TVarSet, ModName,
-                InstanceContext, ItemSeqNum),
+                Types, OriginalTypes,
+                instance_body_concrete(MethodList), TVarSet,
+                ModName, InstanceContext, ItemSeqNum),
             MaybeItemInstance1 = ok1(ItemInstance),
             check_tvars_in_instance_constraint(MaybeItemInstance1, Name,
                 MaybeItemInstance)
@@ -755,8 +759,8 @@
 check_tvars_in_instance_constraint(error1(Specs), _, error1(Specs)).
 check_tvars_in_instance_constraint(ok1(ItemInstance), InstanceTerm, Result) :-
     % XXX
-    ItemInstance = item_instance_info(Constraints, _Name, Types, _Methods,
-        TVarSet, _ModName, _Context, _SeqNum),
+    ItemInstance = item_instance_info(Constraints, _Name, Types,
+        _OriginalTypes, _Methods, TVarSet, _ModName, _Context, _SeqNum),
     % Check that all of the type variables in the constraints on the instance
     % declaration also occur in the type class argument types in the instance
     % declaration.
Index: compiler/prog_item.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_item.m,v
retrieving revision 1.45
diff -u -b -r1.45 prog_item.m
--- compiler/prog_item.m	22 Nov 2011 23:04:53 -0000	1.45
+++ compiler/prog_item.m	5 Jun 2012 15:05:34 -0000
@@ -260,9 +260,13 @@
 
 :- type item_instance_info
     --->    item_instance_info(
+                % The original types field preserves the types in the instance
+                % declaration as written by the programmer. The types field
+                % is subject to the expansion of equivalent types.
                 ci_deriving_class               :: list(prog_constraint),
                 ci_class_name                   :: class_name,
                 ci_types                        :: list(mer_type),
+                ci_original_types               :: list(mer_type),
                 ci_method_instances             :: instance_body,
                 ci_varset                       :: tvarset,
                 ci_module_containing_instance   :: module_name,
Index: compiler/recompilation.usage.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/recompilation.usage.m,v
retrieving revision 1.64
diff -u -b -r1.64 recompilation.usage.m
--- compiler/recompilation.usage.m	23 Apr 2012 03:34:49 -0000	1.64
+++ compiler/recompilation.usage.m	5 Jun 2012 15:05:35 -0000
@@ -1012,8 +1012,9 @@
     recompilation_usage_info::in, recompilation_usage_info::out) is det.
 
 find_items_used_by_instance(ClassId, Defn, !Info) :-
+    % XXX Should we process OriginalArgTypes as we do ArgTypes?
     Defn = hlds_instance_defn(InstanceModuleName, _, _, Constraints,
-        ArgTypes, _, _, _, _),
+        ArgTypes, _OriginalArgTypes, _, _, _, _),
     % XXX Handle interface (currently not needed because the interfaces
     % for imported instances are only needed with --intermodule-optimization,
     % which isn't handled here yet).
Index: compiler/recompilation.version.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/recompilation.version.m,v
retrieving revision 1.81
diff -u -b -r1.81 recompilation.version.m
--- compiler/recompilation.version.m	23 Apr 2012 03:34:49 -0000	1.81
+++ compiler/recompilation.version.m	5 Jun 2012 15:05:36 -0000
@@ -328,7 +328,7 @@
         Item = item_instance(ItemInstance)
     ->
         ItemInstance =
-            item_instance_info(_, ClassName, ClassArgs, _, _, _, _, _),
+            item_instance_info(_, ClassName, ClassArgs, _, _, _, _, _, _),
         Instances0 = !.Info ^ instances,
         ClassArity = list.length(ClassArgs),
         ClassItemName = item_name(ClassName, ClassArity),
@@ -941,12 +941,12 @@
         )
     ;
         Item1 = item_instance(ItemInstance1),
-        ItemInstance1 = item_instance_info(Constraints, Name, Types, Body,
-            _, Module, _, _),
+        ItemInstance1 = item_instance_info(Constraints, Name,
+            Types, OriginalTypes, Body, _, Module, _, _),
         (
             Item2 = item_instance(ItemInstance2),
-            ItemInstance2 = item_instance_info(Constraints, Name, Types, Body,
-                _, Module, _, _)
+            ItemInstance2 = item_instance_info(Constraints, Name,
+                Types, OriginalTypes, Body, _, Module, _, _)
         ->
             Unchanged = yes
         ;
cvs diff: Diffing compiler/notes
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/base64
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/fixed
cvs diff: Diffing extras/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_allegro
cvs diff: Diffing extras/graphics/mercury_allegro/examples
cvs diff: Diffing extras/graphics/mercury_allegro/samples
cvs diff: Diffing extras/graphics/mercury_allegro/samples/demo
cvs diff: Diffing extras/graphics/mercury_allegro/samples/mandel
cvs diff: Diffing extras/graphics/mercury_allegro/samples/pendulum2
cvs diff: Diffing extras/graphics/mercury_allegro/samples/speed
cvs diff: Diffing extras/graphics/mercury_cairo
cvs diff: Diffing extras/graphics/mercury_cairo/samples
cvs diff: Diffing extras/graphics/mercury_cairo/samples/data
cvs diff: Diffing extras/graphics/mercury_cairo/tutorial
cvs diff: Diffing extras/graphics/mercury_glfw
cvs diff: Diffing extras/graphics/mercury_glfw/samples
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/log4m
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/monte
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/mopenssl
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/net
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/posix/samples
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
cvs diff: Diffing m4
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/appengine
cvs diff: Diffing samples/appengine/war
cvs diff: Diffing samples/appengine/war/WEB-INF
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/standalone_c
cvs diff: Diffing samples/concurrency
cvs diff: Diffing samples/concurrency/dining_philosophers
cvs diff: Diffing samples/concurrency/midimon
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/java_interface
cvs diff: Diffing samples/java_interface/java_calls_mercury
cvs diff: Diffing samples/java_interface/mercury_calls_java
cvs diff: Diffing samples/lazy_list
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/solver_types
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing ssdb
cvs diff: Diffing tests
cvs diff: Diffing tests/analysis
cvs diff: Diffing tests/analysis/ctgc
cvs diff: Diffing tests/analysis/excp
cvs diff: Diffing tests/analysis/ext
cvs diff: Diffing tests/analysis/sharing
cvs diff: Diffing tests/analysis/table
cvs diff: Diffing tests/analysis/trail
cvs diff: Diffing tests/analysis/unused_args
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/feedback
cvs diff: Diffing tests/feedback/mandelbrot
cvs diff: Diffing tests/feedback/mmc
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/Mmakefile,v
retrieving revision 1.249
diff -u -b -r1.249 Mmakefile
--- tests/invalid/Mmakefile	1 Dec 2011 04:59:33 -0000	1.249
+++ tests/invalid/Mmakefile	5 Jun 2012 15:05:38 -0000
@@ -71,6 +71,7 @@
 	conflicting_fs \
 	conflicting_tabling_pragmas \
 	constrained_poly_insts \
+	constraint_proof_bug_lib \
 	constructor_warning \
 	cyclic_typeclass \
 	cyclic_typeclass_2 \
Index: tests/invalid/constraint_proof_bug_lib.err_exp
===================================================================
RCS file: tests/invalid/constraint_proof_bug_lib.err_exp
diff -N tests/invalid/constraint_proof_bug_lib.err_exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/invalid/constraint_proof_bug_lib.err_exp	5 Jun 2012 15:05:38 -0000
@@ -0,0 +1,4 @@
+constraint_proof_bug_lib.m:045: In instance declaration for
+constraint_proof_bug_lib.m:045:   `constraint_proof_bug_lib.constrainable(constraint_proof_bug_lib.code)':
+constraint_proof_bug_lib.m:045:   the first argument is an abstract exported
+constraint_proof_bug_lib.m:045:   equivalence type.
Index: tests/invalid/constraint_proof_bug_lib.m
===================================================================
RCS file: tests/invalid/constraint_proof_bug_lib.m
diff -N tests/invalid/constraint_proof_bug_lib.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/invalid/constraint_proof_bug_lib.m	5 Jun 2012 15:05:38 -0000
@@ -0,0 +1,63 @@
+% vim: ts=4 sw=4 et ft=mercury
+
+:- module constraint_proof_bug_lib.
+
+:- interface.
+
+:- type date.
+:- type code.
+
+:- type field(T1, T2)
+    --->    d(T1)
+    ;       c(T2).
+
+:- type dep_op == string.
+
+:- typeclass constrainable(T) where [
+      pred apply_op(T::in, dep_op::in, T::in) is semidet
+  ].
+
+:- instance constrainable(date).
+:- instance constrainable(code).
+:- instance constrainable(field(T, T2))
+    <= (constrainable(T), constrainable(T2)).
+
+:- pred get_date_date(int::out, int::out, int::out, date::in) is det.
+
+:- implementation.
+
+:- type code == int.
+:- type date
+    --->    d(int).
+
+get_date_date(Y, M, D, _Date) :- Y=1999, M=6, D=25.
+
+:- instance constrainable(date) where [
+    pred(apply_op/3) is apply_op_dates
+].
+
+:- pred apply_op_dates(date::in, dep_op::in, date::in) is semidet.
+
+apply_op_dates(D1, "=", D2) :-
+    get_date_date(Y1, M1, Day1, D1),
+    get_date_date(Y1, M1, Day1, D2).
+
+:- instance constrainable(code) where [
+    pred(apply_op/3) is apply_op_codes
+].
+
+:- pred apply_op_codes(code::in, dep_op::in, code::in) is semidet.
+
+apply_op_codes(D1, "=", D2) :- compare((=), D1, D2).
+
+:- instance constrainable(field(T, T2)) <=
+    (constrainable(T), constrainable(T2))
+where [
+    pred(apply_op/3) is apply_op_fields
+].
+
+:- pred apply_op_fields(field(T, T2)::in, dep_op::in, field(T, T2)::in)
+    is semidet <= (constrainable(T), constrainable(T2)).
+
+apply_op_fields(d(D1), Op, d(D2)) :- apply_op(D1, Op, D2).
+apply_op_fields(c(D1), Op, c(D2)) :- apply_op(D1, Op, D2).
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/par_conj
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/stm
cvs diff: Diffing tests/stm/orig
cvs diff: Diffing tests/stm/orig/stm-compiler
cvs diff: Diffing tests/stm/orig/stm-compiler/test1
cvs diff: Diffing tests/stm/orig/stm-compiler/test10
cvs diff: Diffing tests/stm/orig/stm-compiler/test2
cvs diff: Diffing tests/stm/orig/stm-compiler/test3
cvs diff: Diffing tests/stm/orig/stm-compiler/test4
cvs diff: Diffing tests/stm/orig/stm-compiler/test5
cvs diff: Diffing tests/stm/orig/stm-compiler/test6
cvs diff: Diffing tests/stm/orig/stm-compiler/test7
cvs diff: Diffing tests/stm/orig/stm-compiler/test8
cvs diff: Diffing tests/stm/orig/stm-compiler/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/stmqueue
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test10
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test11
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test9
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
cvs diff: Diffing tests/valid
Index: tests/valid/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/valid/Mmakefile,v
retrieving revision 1.250
diff -u -b -r1.250 Mmakefile
--- tests/valid/Mmakefile	3 Dec 2011 13:35:16 -0000	1.250
+++ tests/valid/Mmakefile	5 Jun 2012 15:05:39 -0000
@@ -20,7 +20,6 @@
 TYPECLASS_PROGS= \
 	abstract_typeclass \
 	complex_constraint \
-	constraint_proof_bug \
 	exists_bug \
 	exists_fundeps \
 	exists_fundeps_2 \
@@ -325,6 +324,7 @@
 
 # XXX The type checker can't handle the following test cases yet,
 # unless constraint-based typechecking is used:
+#
 #	ambiguity_stress_test
 #
 # XXX The mode system can't handle the following test cases yet:
@@ -335,11 +335,14 @@
 #	unify_inst_bug
 #
 # XXX We also don't pass this one (see the comments in it for details):
+#
 #	mode_selection
 #
-# XXX The following test is not valid under the current Mercury
+# XXX The following tests are not valid under the current Mercury
 # language rules:
+#
 #	field_detism
+#	constraint_proof_bug
 #
 # The following test case checked for a problem with the varsets attached
 # to mutables.  It only ever worked in the presence of automatic solver
Index: tests/valid/constraint_proof_bug_lib.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/valid/constraint_proof_bug_lib.m,v
retrieving revision 1.2
diff -u -b -r1.2 constraint_proof_bug_lib.m
--- tests/valid/constraint_proof_bug_lib.m	21 May 2007 04:23:26 -0000	1.2
+++ tests/valid/constraint_proof_bug_lib.m	5 Jun 2012 15:05:39 -0000
@@ -1,57 +1,63 @@
-:-module constraint_proof_bug_lib.
+% vim: ts=4 sw=4 et ft=mercury
 
-:-interface.
-:-type date.
-:-type code.
-:-type field(T1,T2)---> d(T1);c(T2).
-:-type dep_op==string.
-
-:-typeclass constrainable(T) 
-  where [
-	  pred apply_op(T::in,dep_op::in,T::in) is semidet
+:- module constraint_proof_bug_lib.
+
+:- interface.
+
+:- type date.
+:- type code.
+
+:- type field(T1, T2)
+    --->    d(T1)
+    ;       c(T2).
+
+:- type dep_op == string.
+
+:- typeclass constrainable(T) where [
+      pred apply_op(T::in, dep_op::in, T::in) is semidet
 	  ].
-:-instance constrainable(date). 
-:-instance constrainable(code). 
-:-instance constrainable(field(T,T2)) <= (constrainable(T),constrainable(T2)).
 
-:-pred get_date_date(int::out,int::out,int::out,date::in) is det.
+:- instance constrainable(date).
+:- instance constrainable(code).
+:- instance constrainable(field(T, T2))
+    <= (constrainable(T), constrainable(T2)).
+
+:- pred get_date_date(int::out, int::out, int::out, date::in) is det.
 
 :- implementation.
 
-:-type code==int.
-:-type date--->d(int).
+:- type code == int.
+:- type date
+    --->    d(int).
 
-get_date_date(Y,M,D,_Date):-Y=1999,M=6,D=25 .
+get_date_date(Y, M, D, _Date) :- Y=1999, M=6, D=25.
 
-:-instance constrainable(date) 
-  where [
+:- instance constrainable(date) where [
 	  pred(apply_op/3) is apply_op_dates
-	    ].
+].
+
+:- pred apply_op_dates(date::in, dep_op::in, date::in) is semidet.
 
-:-pred apply_op_dates(date::in,dep_op::in,date::in) is semidet.
-apply_op_dates(D1,"=",D2):-
-	get_date_date(Y1,M1,Day1,D1),
-	get_date_date(Y1,M1,Day1,D2).
+apply_op_dates(D1, "=", D2) :-
+    get_date_date(Y1, M1, Day1, D1),
+    get_date_date(Y1, M1, Day1, D2).
 
-:-instance constrainable(code) 
-  where [
+:- instance constrainable(code) where [
 	  pred(apply_op/3) is apply_op_codes
-	    ].
+].
 
-:-pred apply_op_codes(code::in,dep_op::in,code::in) is semidet.
-apply_op_codes(D1,"=",D2):-compare((=),D1,D2).
+:- pred apply_op_codes(code::in, dep_op::in, code::in) is semidet.
 
+apply_op_codes(D1, "=", D2) :- compare((=), D1, D2).
 
-:-instance constrainable(field(T,T2)) <= (constrainable(T),constrainable(T2)) 
-  where [
+:- instance constrainable(field(T, T2)) <=
+    (constrainable(T), constrainable(T2))
+where [
 	  pred(apply_op/3) is apply_op_fields
-	    ].
-
-:-pred apply_op_fields(field(T,T2),dep_op,field(T,T2)) <= (constrainable(T),
-							   constrainable(T2)).
-:-mode apply_op_fields(in,in,in) is semidet.
-
-apply_op_fields(d(D1),Op,d(D2)):-apply_op(D1,Op,D2).
-apply_op_fields(c(D1),Op,c(D2)):-apply_op(D1,Op,D2).
+].
 
+:- pred apply_op_fields(field(T, T2)::in, dep_op::in, field(T, T2)::in)
+    is semidet <= (constrainable(T), constrainable(T2)).
 
+apply_op_fields(d(D1), Op, d(D2)) :- apply_op(D1, Op, D2).
+apply_op_fields(c(D1), Op, c(D2)) :- apply_op(D1, Op, D2).
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------



More information about the reviews mailing list