[m-rev.] Ignore module qualification in inst matching

[Ralph Becket]

(Pending bootcheck.)

Estimated hours taken: 0.75
Branches: main

compiler/inst_match.m:
	Ingore module qualification when testing insts for (dis)equality.
	This improves the robustness of inst matching and works around
	apparent bug in the module qualification of insts (it seems they
	are not currently being fully module qualified).

Index: compiler/inst_match.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/inst_match.m,v
retrieving revision 1.61
diff -u -r1.61 inst_match.m
--- compiler/inst_match.m	19 Jan 2005 03:10:36 -0000	1.61
+++ compiler/inst_match.m	27 Jan 2005 04:13:30 -0000
@@ -667,6 +667,33 @@
 equivalent_sym_names(qualified(QualA, S), qualified(QualB, S)) :-
 	equivalent_sym_names(QualA, QualB).
 
+	% Check that the first cons_id is lexically greater than the
+	% second, after all module qualifiers have been removed.
+	%
+:- pred greater_than_after_dequal(cons_id::in, cons_id::in)
+	is semidet.
+
+greater_than_after_dequal(ConsIdA, ConsIdB) :-
+	(
+		ConsIdA = cons(QNameA, ArityA),
+		ConsIdB = cons(QNameB, ArityB)
+	->
+		(	QNameA = unqualified(NameA)
+		;	QNameA = qualified(_, NameA)
+		),
+		(	QNameB = unqualified(NameB)
+		;	QNameB = qualified(_, NameB)
+		),
+		(
+			NameA @> NameB
+		;
+			NameA = NameB,
+			ArityA @> ArityB
+		)
+	;
+		ConsIdA @> ConsIdB
+	).
+
 %-----------------------------------------------------------------------------%
 
 	% Update the inst_var_sub that is computed by inst_matches_initial.
@@ -863,13 +890,14 @@
 bound_inst_list_matches_initial([X | Xs], [Y | Ys], MaybeType, !Info) :-
 	X = functor(ConsIdX, ArgsX),
 	Y = functor(ConsIdY, ArgsY),
-	( ConsIdX = ConsIdY ->
+	( equivalent_cons_ids(ConsIdX, ConsIdY) ->
 		maybe_get_cons_id_arg_types(!.Info ^ module_info, MaybeType,
 			ConsIdX, list__length(ArgsX), MaybeTypes),
 		inst_list_matches_initial(ArgsX, ArgsY, MaybeTypes, !Info),
 		bound_inst_list_matches_initial(Xs, Ys, MaybeType, !Info)
 	;
-		compare(>, ConsIdX, ConsIdY),
+		greater_than_after_dequal(ConsIdX, ConsIdY),
 			% ConsIdY does not occur in [X | Xs].
 			% Hence [X | Xs] implicitly specifies `not_reached'
 			% for the args of ConsIdY, and hence
@@ -1059,13 +1087,14 @@
 bound_inst_list_matches_final([X | Xs], [Y | Ys], MaybeType, !Info) :-
 	X = functor(ConsIdX, ArgsX),
 	Y = functor(ConsIdY, ArgsY),
-	( ConsIdX = ConsIdY ->
+	( equivalent_cons_ids(ConsIdX, ConsIdY) ->
 		maybe_get_cons_id_arg_types(!.Info ^ module_info, MaybeType,
 			ConsIdX, list__length(ArgsX), MaybeTypes),
 		inst_list_matches_final(ArgsX, ArgsY, MaybeTypes, !Info),
 		bound_inst_list_matches_final(Xs, Ys, MaybeType, !Info)
 	;
-		compare(>, ConsIdX, ConsIdY),
+		greater_than_after_dequal(ConsIdX, ConsIdY),
 			% ConsIdY does not occur in [X | Xs].
 			% Hence [X | Xs] implicitly specifies `not_reached'
 			% for the args of ConsIdY, and hence
@@ -1205,13 +1234,14 @@
 bound_inst_list_matches_binding([X | Xs], [Y | Ys], MaybeType, !Info) :-
 	X = functor(ConsIdX, ArgsX),
 	Y = functor(ConsIdY, ArgsY),
-	( ConsIdX = ConsIdY ->
+	( equivalent_cons_ids(ConsIdX, ConsIdY) ->
 		maybe_get_cons_id_arg_types(!.Info ^ module_info, MaybeType,
 			ConsIdX, list__length(ArgsX), MaybeTypes),
 		inst_list_matches_binding(ArgsX, ArgsY, MaybeTypes, !Info),
 		bound_inst_list_matches_binding(Xs, Ys, MaybeType, !Info)
 	;
-		compare(>, ConsIdX, ConsIdY),
+		greater_than_after_dequal(ConsIdX, ConsIdY),
 			% ConsIdX does not occur in [X | Xs].
 			% Hence [X | Xs] implicitly specifies `not_reached'
 			% for the args of ConsIdY, and hence

--------------------------------------------------------------------------
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
--------------------------------------------------------------------------