[m-rev.] diff: fix predicate equivalence type bugs

[Simon Taylor]

Estimated hours taken: 1.5
Branches: main

Fix bugs in the handling of predicate and function
declarations using `with_type`.

compiler/prog_io.m:
	Fix spurious errors for `with_type` and determinism
	in the one declaration. Function declarations with
	the default modes can use this form of declaration.

compiler/mercury_to_mercury.m:
	Fix the order of `with_type` annotations and class constraints.

tests/recompilation/unchanged_with_type*:
	Test case.

Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.211
diff -u -u -r1.211 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m	7 Apr 2002 10:22:41 -0000	1.211
+++ compiler/mercury_to_mercury.m	8 Apr 2002 19:11:23 -0000
@@ -1747,7 +1747,7 @@
 	->
 		{ AppendVarnums = no },
 		mercury_format_pred_or_func_type_2(PredOrFunc, TypeVarSet,
-			ExistQVars, PredName, Types, WithType, MaybeDet,
+			ExistQVars, PredName, Types, WithType, no,
 			Purity, ClassContext, Context, AppendVarnums,
 			StartString, Separator),
 		mercury_format_pred_or_func_mode_decl_2(InstVarSet,
@@ -1812,14 +1812,18 @@
 		add_string("("),
 		mercury_format_term(Type, VarSet, AppendVarnums),
 		mercury_format_remaining_terms(Rest, VarSet, AppendVarnums),
-		add_string(")"),
-		mercury_format_class_context(ClassContext, ExistQVars, VarSet,
-			AppendVarnums)
+		add_string(")")
 	;
-		mercury_format_bracketed_sym_name(PredName),
-		mercury_format_class_context(ClassContext, ExistQVars, VarSet,
-			AppendVarnums),
-		mercury_format_det_annotation(MaybeDet)
+		mercury_format_bracketed_sym_name(PredName)
+	),
+
+	(
+		{ MaybeWithType = yes(WithType) },
+		add_string(" `with_type` ("),
+		mercury_format_term(WithType, VarSet, AppendVarnums),
+		add_string(")")
+	;
+		{ MaybeWithType = no }
 	),
 
 	% We need to handle is/2 specially, because it's used for
@@ -1836,21 +1840,19 @@
 	% efficient.
 
 	(
+		{ PredOrFunc = predicate },
+		{ MaybeDet = no },
 		{ unqualify_name(PredName, "is") },
 		{ list__length(Types, 2) }
 	->
-		mercury_format_det_annotation(MaybeDet)
+		% This determinism will be ignored.
+		mercury_format_det_annotation(yes(det))
 	;
-		[]
-	),
-	(
-		{ MaybeWithType = yes(WithType) },
-		add_string(" `with_type` ("),
-		mercury_format_term(WithType, VarSet, AppendVarnums),
-		add_string(")")
-	;
-		{ MaybeWithType = no }
+		mercury_format_det_annotation(MaybeDet)
 	),
+
+	mercury_format_class_context(ClassContext,
+		ExistQVars, VarSet, AppendVarnums),
 	add_string(Separator).
 
 %-----------------------------------------------------------------------------%
Index: compiler/prog_io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io.m,v
retrieving revision 1.206
diff -u -u -r1.206 prog_io.m
--- compiler/prog_io.m	7 Apr 2002 10:22:49 -0000	1.206
+++ compiler/prog_io.m	8 Apr 2002 10:48:01 -0000
@@ -1490,8 +1490,6 @@
 	    WithInst0 = ok(WithInst),
 	    ( MaybeDeterminism = yes(_), WithInst = yes(_) ->
 		R = error("`with_inst` and determinism both specified", Body)
-	    ; MaybeDeterminism = yes(_), WithType = yes(_) ->
-		R = error("`with_type` and determinism both specified", Body)
 	    ; WithInst = yes(_), WithType = no ->
 		R = error("`with_inst` specified without `with_type`", Body)
 	    ;
Index: tests/recompilation/unchanged_with_type_nr.exp.1
===================================================================
RCS file: /home/mercury1/repository/tests/recompilation/unchanged_with_type_nr.exp.1,v
retrieving revision 1.1
diff -u -u -r1.1 unchanged_with_type_nr.exp.1
--- tests/recompilation/unchanged_with_type_nr.exp.1	15 Mar 2002 07:32:26 -0000	1.1
+++ tests/recompilation/unchanged_with_type_nr.exp.1	8 Apr 2002 15:14:37 -0000
@@ -3,3 +3,4 @@
 OK
 OK
 OK
+OK
Index: tests/recompilation/unchanged_with_type_nr.exp.2
===================================================================
RCS file: /home/mercury1/repository/tests/recompilation/unchanged_with_type_nr.exp.2,v
retrieving revision 1.1
diff -u -u -r1.1 unchanged_with_type_nr.exp.2
--- tests/recompilation/unchanged_with_type_nr.exp.2	15 Mar 2002 07:32:26 -0000	1.1
+++ tests/recompilation/unchanged_with_type_nr.exp.2	8 Apr 2002 15:14:43 -0000
@@ -3,3 +3,4 @@
 OK
 OK
 OK
+OK
Index: tests/recompilation/unchanged_with_type_nr.m.1
===================================================================
RCS file: /home/mercury1/repository/tests/recompilation/unchanged_with_type_nr.m.1,v
retrieving revision 1.1
diff -u -u -r1.1 unchanged_with_type_nr.m.1
--- tests/recompilation/unchanged_with_type_nr.m.1	15 Mar 2002 07:32:26 -0000	1.1
+++ tests/recompilation/unchanged_with_type_nr.m.1	8 Apr 2002 15:14:08 -0000
@@ -25,5 +25,8 @@
 	io__write_string(Str4),
 
 	{ Str5 = with_type_5("OK\n") },
-	io__write_string(Str5).
+	io__write_string(Str5),
+
+	{ Str6 = with_type_6("OK\n") },
+	io__write_string(Str6).
 
Index: tests/recompilation/unchanged_with_type_nr_2.m.1
===================================================================
RCS file: /home/mercury1/repository/tests/recompilation/unchanged_with_type_nr_2.m.1,v
retrieving revision 1.1
diff -u -u -r1.1 unchanged_with_type_nr_2.m.1
--- tests/recompilation/unchanged_with_type_nr_2.m.1	15 Mar 2002 07:32:26 -0000	1.1
+++ tests/recompilation/unchanged_with_type_nr_2.m.1	8 Apr 2002 15:12:52 -0000
@@ -24,6 +24,11 @@
 
 :- func with_type_5 `with_type` map_func(T, T) `with_inst` map_func.
 
+:- func with_type_6 `with_type` map_func(T, T) is det <= string(T).
+
+:- typeclass string(T) where [].
+:- instance string(string) where [].
+
 :- implementation.
 
 with_type_1(_, _, X, X).
@@ -35,3 +40,5 @@
 with_type_4(X, X).
 
 with_type_5(X) = X.
+
+with_type_6(X) = X.
Index: tests/recompilation/unchanged_with_type_nr_2.m.2
===================================================================
RCS file: /home/mercury1/repository/tests/recompilation/unchanged_with_type_nr_2.m.2,v
retrieving revision 1.1
diff -u -u -r1.1 unchanged_with_type_nr_2.m.2
--- tests/recompilation/unchanged_with_type_nr_2.m.2	15 Mar 2002 07:32:26 -0000	1.1
+++ tests/recompilation/unchanged_with_type_nr_2.m.2	8 Apr 2002 15:13:05 -0000
@@ -24,6 +24,11 @@
 
 :- func with_type_5 `with_type` map_func(T, T) `with_inst` map_func.
 
+:- func with_type_6 `with_type` map_func(T, T) is det <= string(T).
+
+:- typeclass string(T) where [].
+:- instance string(string) where [].
+
 :- type t == int.
 
 :- implementation.
@@ -37,3 +42,5 @@
 with_type_4(X, X).
 
 with_type_5(X) = X.
+
+with_type_6(X) = X.
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------