[m-rev.] Bugfixes for test failures due to solver types changes

[Ralph Becket]

Estimated hours taken: 3
Branches: main

Bugfixes (mostly) related to the recent solver types changes.

compiler/type_util.m:
	Having the compiler assume that type variables denote solver types
	causes the compiler to throw an exception when it tries to compile the
	initialisation forwarding predicate for exported abstract type foo(T)
	defined as foo(T) == T.

	The right solution at some point is to introduce a solver type class.

	type_util__is_solver_type no longer assumes that type variables
	denote solver types.

compiler/prog_io.m:
	Fixed a bug in make_maybe_where_details where a solver type without
	user defined equality or comparison would get a
	`yes(unify_compare(no, no))' result rather than just `no'.

tests/invalid/partial_implied_mode.err_exp2:
	Copy of partial_implied_mode.err_exp, but with different temporary
	variable names in the expected compiler errors.

tests/invalid/any_mode.m:
tests/invalid/any_mode.err_exp:
tests/invalid/any_should_not_match_bound.m:
tests/invalid/any_should_not_match_bound.err_exp:
	Updated code and expected error.

tests/misc_tests/pretty_print_test.exp:
	Corrected expected error.

Index: compiler/prog_io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io.m,v
retrieving revision 1.228
diff -u -r1.228 prog_io.m
--- compiler/prog_io.m	5 Sep 2004 23:52:39 -0000	1.228
+++ compiler/prog_io.m	9 Sep 2004 05:58:40 -0000
@@ -2031,10 +2031,18 @@
 			EqualityIsResult       = ok(MaybeEqPred),
 			ComparisonIsResult     = ok(MaybeCmpPred)
 		->
-			ok(yes(solver_type_details(RepnType, InitPred,
-					GroundInst, AnyInst)),
-			   yes(unify_compare(MaybeEqPred, MaybeCmpPred))
-			)
+			MaybeSolverTypeDetails = yes(solver_type_details(
+				RepnType, InitPred, GroundInst, AnyInst)),
+			(
+				MaybeEqPred = no,
+				MaybeCmpPred = no
+			->
+				MaybeUnifyCompare = no
+			;
+				MaybeUnifyCompare = yes(unify_compare(
+					MaybeEqPred, MaybeCmpPred))
+			),
+			ok(yes(MaybeSolverTypeDetails, MaybeUnifyCompare))
 		;
 			error("missing solver type attribute: " ++
 				"required solver type attributes are " ++
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.142
diff -u -r1.142 type_util.m
--- compiler/type_util.m	5 Sep 2004 23:52:47 -0000	1.142
+++ compiler/type_util.m	9 Sep 2004 04:50:40 -0000
@@ -866,13 +866,19 @@
 	hlds_data__get_type_defn_body(TypeDefn, TypeBody).
 
 
-	% We assume that type variables may refer to solver types.
-type_util__is_solver_type(_ModuleInfo, term__variable(_)).
-
-type_util__is_solver_type( ModuleInfo, Type) :-
+	% XXX We can't assume that type variables refer to solver types
+	% because otherwise the compiler will try to construct initialisation
+	% forwarding predicates for exported abstract types defined to be
+	% equivalent to a type variable parameter.  This, of course, will
+	% lead to the compiler throwing an exception.  The correct solution
+	% is to introduce a solver typeclass, but that's something for
+	% another day.
+	%
+type_util__is_solver_type(ModuleInfo, Type) :-
 		% type_to_type_defn_body will fail for builtin types such
 		% as `int/0'.  Such types are not solver types so
-		% type_util__is_solver_type fails too.
+		% type_util__is_solver_type fails too.  type_to_type_defn_body
+		% also fails for type variables.
 	type_to_type_defn_body(ModuleInfo, Type, TypeBody),
 	type_body_is_solver_type(ModuleInfo, TypeBody).
 
Index: tests/hard_coded/any_free_unify.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/any_free_unify.m,v
retrieving revision 1.2
diff -u -r1.2 any_free_unify.m
--- tests/hard_coded/any_free_unify.m	25 Jul 2003 02:27:35 -0000	1.2
+++ tests/hard_coded/any_free_unify.m	9 Sep 2004 06:02:43 -0000
@@ -14,7 +14,7 @@
 	{ test_any_free_unify([], Result1) },
 	io__print(Result1), io__nl.
 
-:- solver type foo ---> bar ; baz.
+:- solver type foo.
 
 :- pred test_any_free_unify(list(foo), bool).
 :- mode test_any_free_unify(in(list_skel(any)), out) is det.
Index: tests/invalid/any_mode.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/any_mode.err_exp,v
retrieving revision 1.7
diff -u -r1.7 any_mode.err_exp
--- tests/invalid/any_mode.err_exp	23 Aug 2004 09:53:12 -0000	1.7
+++ tests/invalid/any_mode.err_exp	9 Sep 2004 05:08:50 -0000
@@ -1,15 +1,5 @@
-any_mode.m:005: Error: mode declaration for predicate `any_mode.p/1'
-any_mode.m:005:   without preceding `pred' declaration.
-any_mode.m:005: Error: no determinism declaration for exported
-any_mode.m:005:   predicate `any_mode.p/1'.
-any_mode.m:008: Error: mode declaration for predicate `any_mode.q/1'
-any_mode.m:008:   without preceding `pred' declaration.
-any_mode.m:008: Error: no determinism declaration for exported
-any_mode.m:008:   predicate `any_mode.q/1'.
-any_mode.m:006: Warning: clause in module interface.
-any_mode.m:009: Warning: clause in module interface.
-any_mode.m:005: Inferred :- pred p((any_mode.foo)).
-any_mode.m:008: Inferred :- pred q((any_mode.foo)).
+any_mode.m:001: Warning: interface for module `any_mode' does not export
+any_mode.m:001:   anything.
 any_mode.m:006: In clause for `p((any >> ground))':
 any_mode.m:006:   in argument 1 of call to predicate `any_mode.q/1':
 any_mode.m:006:   mode error: variable `X' has instantiatedness `any',
Index: tests/invalid/any_mode.m
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/any_mode.m,v
retrieving revision 1.3
diff -u -r1.3 any_mode.m
--- tests/invalid/any_mode.m	25 Aug 2004 08:21:28 -0000	1.3
+++ tests/invalid/any_mode.m	9 Sep 2004 05:08:50 -0000
@@ -1,11 +1,32 @@
 :- module any_mode.
 
-:- interface.
+:- implementation.
 
-:- mode p(any >> ground).
+:- pred p(foo::(any >> ground)) is semidet.
 p(X) :- q(X).
 
-:- mode q(in).
-q(bar).
+:- pred q(foo::in) is semidet.
+q(foo(123)).
+
+:- solver type foo
+	where representation is int,
+	      initialisation is init_foo,
+	      ground         is ground,
+	      any            is ground,
+	      equality       is eq_foo.
+
+:- pred init_foo(foo::out(any)) is det.
+init_foo(foo(42)).
+
+:- func foo(int::in) = (foo::out(any)) is det.
+:- pragma promise_pure(foo/1).
+foo(N) = X :-
+	impure X = 'representation to any foo/0'(N).
+
+:- pred eq_foo(foo::in(any), foo::in(any)) is semidet.
+:- pragma promise_pure(eq_foo/2).
+eq_foo(X, Y) :-
+	impure RX = 'representation of any foo/0'(X),
+	impure RY = 'representation of any foo/0'(Y),
+	RX = RY.
 
-:- solver type foo ---> bar ; baz.
Index: tests/invalid/any_should_not_match_bound.m
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/any_should_not_match_bound.m,v
retrieving revision 1.1
diff -u -r1.1 any_should_not_match_bound.m
--- tests/invalid/any_should_not_match_bound.m	25 Jul 2003 02:27:37 -0000	1.1
+++ tests/invalid/any_should_not_match_bound.m	9 Sep 2004 05:13:42 -0000
@@ -9,7 +9,7 @@
 :- pred test_any_du(du(T)::in(any), du(T)::out) is det.
 :- pred test_any_solver(foo::in(any), foo::out) is det.
 
-:- solver type foo ---> bar ; baz.
+:- solver type foo.
 
 :- type du(T) ---> nil ; cons(T, du(T)).
 
@@ -28,3 +28,28 @@
 
 test_any_solver(X, Y) :-
 	p(X, Y).
+
+
+
+:- solver type foo
+	where representation is int,
+	      initialisation is init_foo,
+	      ground         is ground,
+	      any            is ground,
+	      equality       is eq_foo.
+
+:- pred init_foo(foo::out(any)) is det.
+init_foo(foo(42)).
+
+:- func foo(int::in) = (foo::out(any)) is det.
+:- pragma promise_pure(foo/1).
+foo(N) = X :-
+	impure X = 'representation to any foo/0'(N).
+
+:- pred eq_foo(foo::in(any), foo::in(any)) is semidet.
+:- pragma promise_pure(eq_foo/2).
+eq_foo(X, Y) :-
+	impure RX = 'representation of any foo/0'(X),
+	impure RY = 'representation of any foo/0'(Y),
+	RX = RY.
+
Index: tests/misc_tests/pretty_print_test.exp
===================================================================
RCS file: /home/mercury1/repository/tests/misc_tests/pretty_print_test.exp,v
retrieving revision 1.5
diff -u -r1.5 pretty_print_test.exp
--- tests/misc_tests/pretty_print_test.exp	17 Jan 2003 05:57:15 -0000	1.5
+++ tests/misc_tests/pretty_print_test.exp	9 Sep 2004 06:10:24 -0000
@@ -7,12 +7,10 @@
 :- type foobar
 	--->	foo
 	;	bar(int)
-	;	baz(int, int)
-	.
+	;	baz(int, int).
 :- type cont(T)
 	--->	foo
-	;	cont(T, cont(T))
-	.
+	;	cont(T, cont(T)).
 :- type eq(T1, T2) == foobar.
 main(DCG_0, DCG_2) :-
 	io.write_int(type_num(42), DCG_0, DCG_1),
Index: tests/valid/solv.m
===================================================================
RCS file: /home/mercury1/repository/tests/valid/solv.m,v
retrieving revision 1.1
diff -u -r1.1 solv.m
--- tests/valid/solv.m	13 Oct 2003 02:29:42 -0000	1.1
+++ tests/valid/solv.m	9 Sep 2004 05:22:35 -0000
@@ -52,7 +52,10 @@
 :- import_module std_util.
 
 :- solver type fd_var
-	---> fd_var(c_pointer).
+	where	representation is c_pointer,
+		initialisation is init_any,
+		ground         is ground,
+		any            is ground.
 
 print_labeling(Vars) -->
 	unsorted_aggregate(labeling(Vars), print_solution).
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------