[m-rev.] Trivial diff: bugfix for missing solver init preds

[Ralph Becket]

Julien Fischer, Thursday, 10 March 2005:
> 
> On Wed, 9 Mar 2005, Ralph Becket wrote:
> 
> > Estimated hours taken: 3
> > Branches: main, release
> >
> > compiler/special_pred.m:
> > 	Ensure that initialisation special preds are type checked (without
> > 	this, the compiler will abort during purity checking if the user
> > 	defines a solver type, but not its initialisation predicate.)
> 
> This change seems to have broken the CLP(R) interface,
> extras/trailed_update and tests/warnings/non_term_user_special.

After close inspection, it seems to have revealed a bug in
non_term_user_special.m!  That file was declaring a solver type foo/1
and defining a solver type foo/0.  The error message was quite correct.

I've fixed the test case and improved the compiler so that it won't
complain about missing equality or comparison predicates for solver
types if the `where ...' part of the solver type definition doesn't
specify them.

Estimated hours taken: 16
Branches: main, release

Fix a test case bug; improve compiler error messages for solver types.

compiler/make_hlds.m:
	Minor formatting improvements.

compiler/special_pred.m:
	special_pred_for_type_needs_typecheck now also takes a special_pred_id
	argument (only special preds using user-supplied code need
	typechecking).

compiler/typecheck.m:
	Pass the special_pred_id to special_pred_for_type_needs_typecheck.

tests/warnings/non_term_user_special.m:
tests/warnings/non_term_user_special.exp:
	Fix test case and expected output.

Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.501
diff -u -r1.501 make_hlds.m
--- compiler/make_hlds.m	10 Mar 2005 02:35:57 -0000	1.501
+++ compiler/make_hlds.m	15 Mar 2005 06:56:35 -0000
@@ -3973,13 +3973,15 @@
     % predicates to be defined only for the kinds of types which do not
     % lead unify_proc__generate_index_clauses to abort.
 
-add_special_preds(TVarSet, Type, TypeCtor, Body, Context, Status, !ModuleInfo) :-
+add_special_preds(TVarSet, Type, TypeCtor, Body, Context, Status,
+        !ModuleInfo) :-
     (
         special_pred_is_generated_lazily(!.ModuleInfo, TypeCtor, Body, Status)
     ->
         true
     ;
-        can_generate_special_pred_clauses_for_type(!.ModuleInfo, TypeCtor, Body)
+        can_generate_special_pred_clauses_for_type(!.ModuleInfo, TypeCtor,
+            Body)
     ->
         add_special_pred(unify, TVarSet, Type, TypeCtor, Body, Context,
             Status, !ModuleInfo),
Index: compiler/special_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/special_pred.m,v
retrieving revision 1.49
diff -u -r1.49 special_pred.m
--- compiler/special_pred.m	9 Mar 2005 04:52:45 -0000	1.49
+++ compiler/special_pred.m	15 Mar 2005 06:56:35 -0000
@@ -83,7 +83,7 @@
 	% or    (c) it is the initialisation predicate for a solver type.
 	%
 :- pred special_pred_for_type_needs_typecheck(module_info::in,
-	hlds_type_body::in) is semidet.
+	special_pred_id::in, hlds_type_body::in) is semidet.
 
 	% Succeed if the type can have clauses generated for
 	% its special predicates. This will fail for abstract
@@ -232,18 +232,25 @@
 	% The special predicates for types with user-defined
 	% equality or existentially typed constructors are always
 	% generated immediately by make_hlds.m.
-	\+ special_pred_for_type_needs_typecheck(ModuleInfo, Body).
+	\+ special_pred_for_type_needs_typecheck(ModuleInfo, unify, Body).
 
-special_pred_for_type_needs_typecheck(ModuleInfo, Body) :-
+special_pred_for_type_needs_typecheck(ModuleInfo, SpecialPredId, Body) :-
 	(
+		SpecialPredId = unify,
 		type_body_has_user_defined_equality_pred(ModuleInfo, Body,
 			unify_compare(_, _))
 	;
+		SpecialPredId = compare,
+		type_body_has_user_defined_equality_pred(ModuleInfo, Body,
+			unify_compare(_, UserCmp)), UserCmp = yes(_)
+	;
+		SpecialPredId \= initialise,
 		Ctors = Body ^ du_type_ctors,
 		list__member(Ctor, Ctors),
 		Ctor = ctor(ExistQTVars, _, _, _),
 		ExistQTVars \= []
 	;
+		SpecialPredId = initialise,
 		type_body_is_solver_type(ModuleInfo, Body)
 	).
 
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.364
diff -u -r1.364 typecheck.m
--- compiler/typecheck.m	4 Mar 2005 05:55:50 -0000	1.364
+++ compiler/typecheck.m	15 Mar 2005 06:56:35 -0000
@@ -837,7 +837,7 @@
 	% predicate, and if so, for which type
 	%
 	pred_info_get_origin(PredInfo, Origin),
-	Origin = special_pred(_SpecialId - TypeCtor),
+	Origin = special_pred(SpecialPredId - TypeCtor),
 	%
 	% check that the special pred isn't one of the builtin
 	% types which don't have a hlds_type_defn
@@ -850,7 +850,7 @@
 	module_info_types(ModuleInfo, TypeTable),
 	map__lookup(TypeTable, TypeCtor, TypeDefn),
 	hlds_data__get_type_defn_body(TypeDefn, Body),
-	special_pred_for_type_needs_typecheck(ModuleInfo, Body).
+	special_pred_for_type_needs_typecheck(ModuleInfo, SpecialPredId, Body).
 
 %-----------------------------------------------------------------------------%
 
Index: tests/warnings/non_term_user_special.exp
===================================================================
RCS file: /home/mercury1/repository/tests/warnings/non_term_user_special.exp,v
retrieving revision 1.1
diff -u -r1.1 non_term_user_special.exp
--- tests/warnings/non_term_user_special.exp	22 Jan 2005 06:12:56 -0000	1.1
+++ tests/warnings/non_term_user_special.exp	15 Mar 2005 06:41:07 -0000
@@ -5,5 +5,5 @@
 non_term_user_special.m:007:   the type non_term_user_special.myset/1 cannot be
 non_term_user_special.m:007:   proven to terminate.
 non_term_user_special.m:039: Warning: the user-defined initialisation predicate
-non_term_user_special.m:039:   for the type non_term_user_special.foo/0 cannot
+non_term_user_special.m:039:   for the type non_term_user_special.foo/1 cannot
 non_term_user_special.m:039:   be proven to terminate.
Index: tests/warnings/non_term_user_special.m
===================================================================
RCS file: /home/mercury1/repository/tests/warnings/non_term_user_special.m,v
retrieving revision 1.1
diff -u -r1.1 non_term_user_special.m
--- tests/warnings/non_term_user_special.m	22 Jan 2005 06:12:56 -0000	1.1
+++ tests/warnings/non_term_user_special.m	15 Mar 2005 06:40:53 -0000
@@ -36,18 +36,18 @@
 		Res = (=)
 	).
 
-:- solver type foo
+:- solver type foo(T)
 	where	representation is int,	
 		initialisation is init_foo,
 		ground         is ground,
 		any            is ground.
 
 :- pragma promise_pure(init_foo/1).
-:- pred init_foo(foo::out(any)) is det.
+:- pred init_foo(foo(T)::out(any)) is det.
 init_foo(X) :-
 	( loop ->
 		Y = 42
 	;	
 		Y = 43
 	),
-	impure X = 'representation to any foo/0'(Y).
+	impure X = 'representation to any foo/1'(Y).
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------