[m-dev.] Re: diff: MLDS back-end: fix existential types bug

[Fergus Henderson]

On 18-May-2000, Fergus Henderson <fjh at cs.mu.oz.au> wrote:
> 
> Fix a bug in the MLDS back-end that broke
> tests/typeclasses/typeclass_exist_method.m.

I committed that one a little prematurely.
Further testing showed up some more bugs.
Hopefully this should fix them.

----------

Estimated hours taken: 3

compiler/ml_code_gen.m:
	Fix some bugs in my previous change to handle boxing of existentally
	typed output arguments.

tests/hard_coded/Mmakefile:
tests/hard_coded/existential_float.m:
tests/hard_coded/existential_float.exp:
	Add some additional test cases testing model_non and model_semi
	procedures.

Workspace: /home/pgrad/fjh/ws/hg
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.44
diff -u -d -r1.44 ml_code_gen.m
--- compiler/ml_code_gen.m	2000/05/17 18:02:09	1.44
+++ compiler/ml_code_gen.m	2000/05/17 21:43:56
@@ -988,12 +988,26 @@
 	%
 	ml_gen_box_existential_outputs(HeadVars, ArgTypes,
 		Context, MLDS_Params0, MLDS_Params, BoxDecls, BoxStatements),
-	{ DoBoxOutputs = (pred(Decls::out, Statements::out, in, out) is det -->
-		{ Decls = BoxDecls, Statements = BoxStatements }
-	) },
-
-	ml_combine_conj(CodeModel, Context,
-		DoGenGoal, DoBoxOutputs, MLDS_Decls, MLDS_Statements0),
+	( { BoxDecls = [], BoxStatements = [] } ->
+		% No boxing required.
+		DoGenGoal(MLDS_Decls, MLDS_Statements0)
+	;
+		% Boxing required.
+		% We need to generate the goal,
+		% box the output arguments,
+		% and then succeeed.
+		{ DoBoxOutputs = (pred(Decls::out, Statements::out, in, out)
+					is det -->
+			ml_gen_success(CodeModel, Context, SuccStatements),
+			{ Decls = [] },
+			{ Statements = list__append(BoxStatements,
+				SuccStatements) }
+		) },
+		ml_combine_conj(CodeModel, Context,
+			DoGenGoal, DoBoxOutputs,
+			MLDS_Decls0, MLDS_Statements0),
+		{ MLDS_Decls = list__append(BoxDecls, MLDS_Decls0) }
+	),
 
 	%
 	% Finally append an appropriate `return' statement, if needed.
Index: tests/hard_coded/existential_float.exp
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/existential_float.exp,v
retrieving revision 1.1
diff -u -d -r1.1 existential_float.exp
--- tests/hard_coded/existential_float.exp	2000/05/17 18:02:23	1.1
+++ tests/hard_coded/existential_float.exp	2000/05/17 21:46:48
@@ -16,3 +16,8 @@
 'c'
 42.0000000000000
 '<<predicate>>'
+33.3000000000000
+no.
+33.3000000000000
+no.
+[univ(2.00000000000000 : float), univ(1.00000000000000 : float)]
Index: tests/hard_coded/existential_float.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/existential_float.m,v
retrieving revision 1.1
diff -u -d -r1.1 existential_float.m
--- tests/hard_coded/existential_float.m	2000/05/17 18:02:24	1.1
+++ tests/hard_coded/existential_float.m	2000/05/17 21:46:21
@@ -8,15 +8,20 @@
 :- interface.
 :- import_module std_util.
 
+:- type foo ---> left ; right.
+
 :- some [T] func call_univ_value(univ) = T.
 
 :- some [T] func my_exist_c = T.
 :- some [T] func my_exist_f = T.
 :- some [T] func my_exist_fn = T.
 
+:- some [T] pred my_exist_p_multi(T::out) is multi.
+:- some [T] pred my_exist_p_semi(foo::in, T::out) is semidet.
+
 :- import_module io.
 
-:- pred main(io__state::di, state::uo) is det.
+:- pred main(io__state::di, state::uo) is cc_multi.
 
 :- implementation.
 :- import_module int.
@@ -33,7 +38,29 @@
 	write(my_exist_fn), nl,
 	write(call_my_exist_c), nl,
 	write(call_my_exist_f), nl,
-	write(call_my_exist_fn), nl.
+	write(call_my_exist_fn), nl,
+	( { call_my_exist_p_semi(left, X1) } ->
+		write(X1), nl
+	;
+		print("no."), nl
+	),
+	( { call_my_exist_p_semi(right, X2) } ->
+		write(X2), nl
+	;
+		print("no."), nl
+	),
+	( { my_exist_p_semi(left, X3) } ->
+		write(X3), nl
+	;
+		print("no."), nl
+	),
+	( { my_exist_p_semi(right, X4) } ->
+		write(X4), nl
+	;
+		print("no."), nl
+	),
+	{ unsorted_solutions(my_univ_p_multi, List) },
+	write(List), nl.
 
 my_exist_c = 'c'.
 
@@ -41,11 +68,23 @@
 
 my_exist_fn = (func(X) = 2 * X).
 
+my_exist_p_multi(1.0).
+my_exist_p_multi(2.0).
+
+my_exist_p_semi(left, 33.3).
+
 call_my_exist_c = my_exist_c.
 
 call_my_exist_f = my_exist_f.
 
 call_my_exist_fn = my_exist_fn.
+
+call_my_exist_p_multi(X) :- my_exist_p_multi(X).
+
+call_my_exist_p_semi(A, B) :- my_exist_p_semi(A, B).
+
+:- mode my_univ_p_multi(out) is multi.
+my_univ_p_multi(univ(X)) :- call_my_exist_p_multi(X).
 
 :- pred foo(univ::in, io__state::di, state::uo) is det.
 foo(X) -->

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh>  |  of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3        |     -- the last words of T. S. Garp.
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------