[m-rev.] diff: allow var-functor unifications for vars with inst `any'.

[David Overton]

Estimated hours taken: 0.5
Branches: main

Allow var-functor unifications where the variable has inst `any'.

compiler/inst_util.m:
	Handle `any' insts in abstractly_unify_inst_functor.

tests/valid/Mmakefile:
tests/valid/any_functor_unify.m:
	Add a test case.

Index: compiler/inst_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/inst_util.m,v
retrieving revision 1.20
diff -u -r1.20 inst_util.m
--- compiler/inst_util.m	20 Mar 2002 12:36:25 -0000	1.20
+++ compiler/inst_util.m	9 May 2002 01:17:54 -0000
@@ -516,8 +516,6 @@
 :- mode abstractly_unify_inst_functor_2(in, in, in, in, in, in, in,
 			out, out, out) is semidet.
 
-	% XXX need to handle `any' insts
-
 abstractly_unify_inst_functor_2(live, not_reached, _, _, _, _, M,
 			not_reached, erroneous, M).
 
@@ -529,6 +527,12 @@
 	maybe_make_shared_inst_list(Args0, ArgLives, ModuleInfo0,
 			Args, ModuleInfo).
 
+abstractly_unify_inst_functor_2(live, any(Uniq), ConsId, ArgInsts,
+		ArgLives, Real, M0, Inst, Det, M) :-
+	make_any_inst_list_lives(ArgInsts, live, ArgLives, Uniq, Real, M0,
+		AnyArgInsts, Det, M),
+	Inst = bound(Uniq, [functor(ConsId, AnyArgInsts)]).
+
 abstractly_unify_inst_functor_2(live, bound(Uniq, ListX), ConsId, Args,
 			ArgLives, Real, M0, bound(Uniq, List), Det, M) :-
 	abstractly_unify_bound_inst_list_lives(ListX, ConsId, Args, ArgLives,
@@ -550,6 +554,11 @@
 abstractly_unify_inst_functor_2(dead, free, ConsId, Args, _ArgLives, _Real, M,
 			bound(unique, [functor(ConsId, Args)]), det, M).
 
+abstractly_unify_inst_functor_2(dead, any(Uniq), ConsId, ArgInsts,
+		_ArgLives, Real, M0, Inst, Det, M) :-
+	make_any_inst_list(ArgInsts, dead, Uniq, Real, M0, AnyArgInsts, Det, M),
+	Inst = bound(Uniq, [functor(ConsId, AnyArgInsts)]).
+
 abstractly_unify_inst_functor_2(dead, bound(Uniq, ListX), ConsId, Args,
 			_ArgLives, Real, M0, bound(Uniq, List), Det, M) :-
 	ListY = [functor(ConsId, Args)],
@@ -1069,6 +1078,26 @@
 		Inst, Det1, ModuleInfo1),
 	make_any_inst_list(Insts0, Live, Uniq, Real, ModuleInfo1,
 		Insts, Det2, ModuleInfo),
+	det_par_conjunction_detism(Det1, Det2, Det).
+
+:- pred make_any_inst_list_lives(list(inst), is_live, list(is_live),
+			uniqueness, unify_is_real,
+			module_info, list(inst), determinism, module_info).
+:- mode make_any_inst_list_lives(in, in, in, in, in, in, out, out, out)
+				is semidet.
+
+make_any_inst_list_lives([], _, _, _, _, ModuleInfo, [], det, ModuleInfo).
+make_any_inst_list_lives([Inst0 | Insts0], Live, [ArgLive | ArgLives],
+		Uniq, Real, ModuleInfo0, [Inst | Insts], Det, ModuleInfo) :-
+	( Live = live, ArgLive = live ->
+		BothLive = live
+	;
+		BothLive = dead
+	),
+	make_any_inst(Inst0, BothLive, Uniq, Real, ModuleInfo0,
+		Inst, Det1, ModuleInfo1),
+	make_any_inst_list_lives(Insts0, Live, ArgLives, Uniq, Real,
+		ModuleInfo1, Insts, Det2, ModuleInfo),
 	det_par_conjunction_detism(Det1, Det2, Det).
 
 %-----------------------------------------------------------------------------%
Index: tests/valid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/valid/Mmakefile,v
retrieving revision 1.100
diff -u -r1.100 Mmakefile
--- tests/valid/Mmakefile	8 May 2002 14:31:50 -0000	1.100
+++ tests/valid/Mmakefile	9 May 2002 01:17:58 -0000
@@ -51,6 +51,7 @@
 	foreign_type_spec.m
 
 OTHER_SOURCES= \
+	any_functor_unify.m \
 	any_inst_merge.m \
 	common_struct_bug.m \
 	compl_unify_bug.m \
Index: tests/valid/any_functor_unify.m
===================================================================
RCS file: tests/valid/any_functor_unify.m
diff -N tests/valid/any_functor_unify.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/valid/any_functor_unify.m	9 May 2002 01:17:58 -0000
@@ -0,0 +1,13 @@
+:- module any_functor_unify.
+:- interface.
+
+:- type wrap ---> wrap(int).
+:- inst wrap(I) ---> wrap(I).
+
+:- pred p(wrap).
+:- mode p(in(any)) is det.
+
+:- implementation.
+
+p(X) :-
+	X = wrap(_).
-- 
David Overton      Computer Science and Software Engineering
PhD Student        The University of Melbourne   +61 3 8344 9159
Research Fellow    Monash University (Clayton)   +61 3 9905 5779
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------