[m-rev.] diff: fix type checking bug (resend)
Mark Brown
mark at csse.unimelb.edu.au
Tue Sep 4 10:22:07 AEST 2007
This didn't get through first time. Trying again...
----- Forwarded message from Mark Brown <mark at csse.unimelb.edu.au> -----
Date: Mon, 3 Sep 2007 21:41:13 +1000
From: Mark Brown <mark at csse.unimelb.edu.au>
To: Mercury Reviews <mercury-reviews at csse.unimelb.edu.au>
Subject: diff: fix type checking bug
User-Agent: Mutt/1.5.16 (2007-06-09)
This fixes a bug reported by Julien a week or two ago.
Cheers,
Mark.
Estimated hours taken: 5
Branches: main
Fix a bug in the handling of unsatisfiable typeclass constraints.
compiler/typeclasses.m:
If context reduction fails, continue with the type assign set from the
start of context reduction rather than a type assign set supplied by
the caller, which may be missing information that will later be
required.
compiler/typecheck.m:
Don't pass the original type assign set.
tests/invalid/Mmakefile:
tests/invalid/typeclass_test_13.err_exp:
tests/invalid/typeclass_test_13.m:
New test case.
tests/invalid/unsatisfiable_constraint_bug.err_exp:
Update the expected output, now that we have the information
required to produce the correct error meswsage.
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.424
diff -u -r1.424 typecheck.m
--- compiler/typecheck.m 7 Aug 2007 07:10:08 -0000 1.424
+++ compiler/typecheck.m 3 Sep 2007 09:29:00 -0000
@@ -483,13 +483,12 @@
typecheck_info_init(!.ModuleInfo, PredId, IsFieldAccessFunction,
TypeVarSet0, VarSet, ExplicitVarTypes0, !.HeadTypeParams,
Constraints, Status, PredMarkers, StartingSpecs, !:Info),
- OrigTypeAssignSet = !.Info ^ tc_info_type_assign_set,
get_clause_list(ClausesRep1, Clauses1),
typecheck_clause_list(HeadVars, ArgTypes0, Clauses1, Clauses,
!Info),
% We need to perform a final pass of context reduction at the end,
% before checking the typeclass constraints.
- perform_context_reduction(OrigTypeAssignSet, !Info),
+ perform_context_reduction(!Info),
typecheck_check_for_ambiguity(whole_pred, HeadVars, !Info),
typecheck_info_get_final_info(!.Info, !.HeadTypeParams,
ExistQVars0, ExplicitVarTypes0, TypeVarSet,
@@ -1227,11 +1226,10 @@
% correctly compute the HeadTypeParams that result from existentially
% typed foreign_procs. (We could probably do that more efficiently
% than the way it is done below, though.)
- OrigTypeAssignSet = !.Info ^ tc_info_type_assign_set,
ArgVars = list.map(foreign_arg_var, Args),
GoalPath = goal_info_get_goal_path(GoalInfo),
typecheck_call_pred_id(PredId, ArgVars, GoalPath, !Info),
- perform_context_reduction(OrigTypeAssignSet, !Info),
+ perform_context_reduction(!Info),
GoalExpr = GoalExpr0
;
GoalExpr0 = shorthand(ShorthandGoal0),
@@ -1371,8 +1369,6 @@
is det.
typecheck_call_pred(CallId, Args, GoalPath, PredId, !Info) :-
- OrigTypeAssignSet = !.Info ^ tc_info_type_assign_set,
-
% Look up the called predicate's arg types.
ModuleInfo = !.Info ^ tc_info_module_info,
module_info_get_predicate_table(ModuleInfo, PredicateTable),
@@ -1406,7 +1402,7 @@
% See the paper: "Type classes: an exploration of the design space",
% S. Peyton-Jones, M. Jones 1997, for a discussion of some of the
% issues.
- perform_context_reduction(OrigTypeAssignSet, !Info)
+ perform_context_reduction(!Info)
;
PredId = invalid_pred_id,
Spec = report_pred_call_error(!.Info, CallId),
@@ -1761,9 +1757,8 @@
typecheck_unify_var_var(X, Y, !Info).
typecheck_unification(X, rhs_functor(Functor, ExistConstraints, Args),
rhs_functor(Functor, ExistConstraints, Args), GoalPath, !Info) :-
- OrigTypeAssignSet = !.Info ^ tc_info_type_assign_set,
typecheck_unify_var_functor(X, Functor, Args, GoalPath, !Info),
- perform_context_reduction(OrigTypeAssignSet, !Info).
+ perform_context_reduction(!Info).
typecheck_unification(X,
rhs_lambda_goal(Purity, PredOrFunc, EvalMethod,
NonLocals, Vars, Modes, Det, Goal0),
Index: compiler/typeclasses.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typeclasses.m,v
retrieving revision 1.21
diff -u -r1.21 typeclasses.m
--- compiler/typeclasses.m 14 May 2007 08:20:12 -0000 1.21
+++ compiler/typeclasses.m 3 Sep 2007 09:29:00 -0000
@@ -26,12 +26,14 @@
%-----------------------------------------------------------------------------%
- % perform_context_reduction(OrigTypeAssignSet, !Info) is true
+ % perform_context_reduction(!Info) is true
% iff either
% (a) !:Info is the typecheck_info that results from performing
% context reduction on the type_assigns in !.Info, or
- % (b) if there is no valid context reduction, then !:Info is !.Info
- % with the type assign set replaced by OrigTypeAssignSet (see below).
+ % (b) if there is no valid context reduction, then an appropriate
+ % error message is given. To avoid reporting the same error at
+ % subsequent calls, !:Info is !.Info with all unproven constraints
+ % removed from the type assign set.
%
% Context reduction is the process of eliminating redundant constraints
% from the constraints in the type_assign and adding the proof of the
@@ -64,15 +66,8 @@
% the constraint has its top level functor bound, but there is no
% instance declaration for that type.
%
- % If all type_assigns from the typecheck_info are rejected, than an
- % appropriate error message is given, the type_assign_set is
- % restored to the original one given by OrigTypeAssignSet,
- % but without any typeclass constraints.
- % The reason for this is to avoid reporting the same error at
- % subsequent calls to perform_context_reduction.
- %
-:- pred perform_context_reduction(type_assign_set::in,
- typecheck_info::in, typecheck_info::out) is det.
+:- pred perform_context_reduction(typecheck_info::in, typecheck_info::out)
+ is det.
% Apply context reduction to the list of class constraints by applying
% the instance rules or superclass rules, building up proofs for
@@ -107,7 +102,7 @@
%-----------------------------------------------------------------------------%
-perform_context_reduction(OrigTypeAssignSet, !Info) :-
+perform_context_reduction(!Info) :-
trace [io(!IO)] (
type_checkpoint("before context reduction", !.Info, !IO)
),
@@ -117,12 +112,12 @@
module_info_get_instance_table(ModuleInfo, InstanceTable),
list.filter_map(
reduce_type_assign_context(ClassTable, InstanceTable),
- TypeAssignSet0, TypeAssignSet),
+ TypeAssignSet0, TypeAssignSet1),
(
% Check that this context reduction hasn't eliminated
% all the type assignments.
TypeAssignSet0 = [_ | _],
- TypeAssignSet = []
+ TypeAssignSet1 = []
->
Spec = report_unsatisfiable_constraints(!.Info, TypeAssignSet0),
typecheck_info_add_error(Spec, !Info),
@@ -136,11 +131,11 @@
Constraints0 ^ assumed, Constraints),
type_assign_set_typeclass_constraints(Constraints, TA0, TA)
),
- list.map(DeleteConstraints, OrigTypeAssignSet, NewTypeAssignSet),
- !:Info = !.Info ^ tc_info_type_assign_set := NewTypeAssignSet
+ list.map(DeleteConstraints, TypeAssignSet0, TypeAssignSet)
;
- !:Info = !.Info ^ tc_info_type_assign_set := TypeAssignSet
- ).
+ TypeAssignSet = TypeAssignSet1
+ ),
+ !:Info = !.Info ^ tc_info_type_assign_set := TypeAssignSet.
:- pred reduce_type_assign_context(class_table::in, instance_table::in,
type_assign::in, type_assign::out) is semidet.
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/Mmakefile,v
retrieving revision 1.220
diff -u -r1.220 Mmakefile
--- tests/invalid/Mmakefile 20 Aug 2007 03:36:21 -0000 1.220
+++ tests/invalid/Mmakefile 3 Sep 2007 09:29:01 -0000
@@ -198,6 +198,7 @@
typeclass_test_10 \
typeclass_test_11 \
typeclass_test_12 \
+ typeclass_test_13 \
typeclass_test_2 \
typeclass_test_3 \
typeclass_test_4 \
Index: tests/invalid/typeclass_test_13.err_exp
===================================================================
RCS file: tests/invalid/typeclass_test_13.err_exp
diff -N tests/invalid/typeclass_test_13.err_exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/invalid/typeclass_test_13.err_exp 3 Sep 2007 09:29:01 -0000
@@ -0,0 +1,8 @@
+typeclass_test_13.m:034: In clause for predicate
+typeclass_test_13.m:034: `mercury_format_pragma_foreign_export_enum_override'/3:
+typeclass_test_13.m:034: unsatisfiable typeclass constraint:
+typeclass_test_13.m:034: `typeclass_test_13.output(U)'.
+typeclass_test_13.m:035: In clause for predicate
+typeclass_test_13.m:035: `mercury_format_pragma_foreign_export_enum_override'/3:
+typeclass_test_13.m:035: unsatisfiable typeclass constraint:
+typeclass_test_13.m:035: `typeclass_test_13.output(U)'.
Index: tests/invalid/typeclass_test_13.m
===================================================================
RCS file: tests/invalid/typeclass_test_13.m
diff -N tests/invalid/typeclass_test_13.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/invalid/typeclass_test_13.m 3 Sep 2007 09:29:01 -0000
@@ -0,0 +1,40 @@
+% The missing constraint at the spot marked XXX causes the following
+% assertion failure in rotd-2007-08-19 and before:
+%
+% Software Error: map.lookup: key not found
+% Key Type: term.var(parse_tree.prog_data.prog_var_type)
+% Key Value: var(4)
+% Value Type: parse_tree.prog_data.mer_type
+%
+:- module typeclass_test_13.
+:- interface.
+
+:- import_module list.
+:- import_module string.
+
+:- typeclass output(U) where [
+ pred add_quoted_string(string::in, U::di, U::uo) is det,
+ pred add_list(list(string)::in,
+ pred(string, U, U)::in(pred(in, di, uo) is det), U::di, U::uo) is det
+].
+
+:- pred mercury_format_pragma_foreign_export_enum_overrides(
+ list(string)::in, U::di, U::uo) is det <= output(U).
+
+:- implementation.
+
+mercury_format_pragma_foreign_export_enum_overrides(Overrides, !U) :-
+ add_list(Overrides, mercury_format_pragma_foreign_export_enum_override,
+ !U).
+
+:- pred mercury_format_pragma_foreign_export_enum_override(
+ string::in, U::di, U::uo) is det. % XXX <= output(U).
+
+mercury_format_pragma_foreign_export_enum_override(CtorName, !U) :-
+ mercury_format_bracketed_sym_name(CtorName, !U),
+ add_quoted_string(CtorName, !U).
+
+:- pred mercury_format_bracketed_sym_name(string::in,
+ U::di, U::uo) is det <= output(U).
+
+mercury_format_bracketed_sym_name(_, !U).
Index: tests/invalid/unsatisfiable_constraint_bug.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/unsatisfiable_constraint_bug.err_exp,v
retrieving revision 1.1
diff -u -r1.1 unsatisfiable_constraint_bug.err_exp
--- tests/invalid/unsatisfiable_constraint_bug.err_exp 21 Nov 2006 11:47:49 -0000 1.1
+++ tests/invalid/unsatisfiable_constraint_bug.err_exp 3 Sep 2007 09:29:01 -0000
@@ -6,4 +6,4 @@
unsatisfiable_constraint_bug.m:025: `stream.reader(S, float, B, E)'.
unsatisfiable_constraint_bug.m:026: In clause for predicate `test_stream'/5:
unsatisfiable_constraint_bug.m:026: unsatisfiable typeclass constraint:
-unsatisfiable_constraint_bug.m:026: `stream.reader(S, float, State, E)'.
+unsatisfiable_constraint_bug.m:026: `stream.reader(S, float, B, E)'.
----- End forwarded message -----
--------------------------------------------------------------------------
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