[m-dev.] [reuse] fixes of some naughty bugs

[Nancy Mazur]

Hi,


===================================================================


Estimated hours taken: 4

Two bugfixes. 
1. In some cases the alias analysis erronuously concluded that foreign
code does not generate aliases, even if there are several output-variables
of non-primitive types. 
2. For constructions where some of the arguments are the same, internal
aliases ought to be generated too. 

pa_alias_as.m:
	Bugfixes: 
	1. do not play it unsafe: don't suppose bottom-aliases when there
	is only one output-variable, even when there are no input-variables. 
	The output-variable might have an internal alias. 
	2. within the predicate remove_all_unique_vars, all variables
	with user defined mode where erronuosly removed too. This is
	fixed by using mode_util__mode_get_insts instead of deconstructing
	the mode directly. 

pa_alias.m:
	Bugfix: in the case of a construction like X = f(Y,Y), only
	the aliases (X/f/1, Y) and (X/f/2, Y) where generated, while
	also the alias (X/f/1, X/f/2) should be generated. 


Index: pa_alias.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/pa_alias.m,v
retrieving revision 1.1.2.6
diff -u -r1.1.2.6 pa_alias.m
--- pa_alias.m	2001/03/05 17:06:50	1.1.2.6
+++ pa_alias.m	2001/03/08 18:13:50
@@ -631,12 +631,96 @@
 		NUMBEREDARGS,
 		1, _ ).
 	
-from_unification( _ProcInfo, _HLDS, 
-		construct( VAR, CONS, ARGS0, _, _, _, _ ), _Info, AS ) :-
-	get_rid_of_damn_typeinfos(CONS,ARGS0, ARGS),
-	number_args( ARGS, NUMBEREDARGS), 
-	list__foldl( alias_from_unif(VAR,CONS),NUMBEREDARGS, [], AS).
+from_unification(_ProcInfo, _HLDS, 
+		construct(Var, Cons, Args0, _, _, _, _), _Info, AS) :-
+	get_rid_of_damn_typeinfos( Cons, Args0, Args),
+	number_args(Args, NumberedArsg), 
+	list__foldl(alias_from_unif(Var, Cons), NumberedArsg, [], AS0), 
+	internal_aliases(NumberedArsg, PosList), 
+	create_internal_aliases(Var, Cons, PosList, AS1), 
+	list__append(AS0, AS1, AS). 
+	
 
+	% Given a list of arguments of the construction, determine all
+	% the sets of positions which refer to the same prog_var. 
+:- pred internal_aliases(list(pair(int, prog_var))::in, 
+		list(list(int))::out) is det.
+internal_aliases(NumberedArgs, PosList):- 
+	list__foldl(
+		pred(NumberedArg::in, Map0::in, Map::out) is det:- 
+		    (
+			NumberedArg = Position - ProgVar, 
+			(
+				map__search(Map0, ProgVar, Positions0)
+			->
+				Positions = [Position | Positions0],
+				map__det_update(Map0, ProgVar, Positions, Map)
+			;
+				map__det_insert(Map0, ProgVar, [Position], Map)
+			)
+		    ),
+		NumberedArgs, 
+		map__init, 
+		FrequencyMap0),
+	map__keys(FrequencyMap0, Keys), 
+	list__foldl(
+		pred(ProgVar::in, List0::in, List::out) is det :- 
+		    (
+			map__lookup(FrequencyMap0, ProgVar, Positions),
+			( 
+				( Positions = [] ; Positions = [_] )
+			-> 
+				List = List0
+			; 	
+				List = [Positions | List0]
+			)
+		    ), 
+		Keys, 
+		[],
+		PosList). 
+
+:- pred create_internal_aliases(prog_var::in, cons_id::in, 
+		list(list(int))::in, list(alias)::out) is det. 
+create_internal_aliases(MainVar, ConsId, PositionLists, Aliases):- 
+	list__foldl(
+		pred(Positions::in, List0::in, List::out) is det:-
+		    (
+			solutions_set(two_by_two(Positions), SetPairs), 
+			set__to_sorted_list(SetPairs, Pairs),
+			list__append(Pairs, List0, List)
+		    ), 
+		PositionLists, 
+		[], 
+		PositionPairs), 
+	list__map(
+		pred(PositionPair::in, Alias::out) is det:-
+		    (
+			PositionPair = Pos0 - Pos1,
+			pa_datastruct__init(MainVar, ConsId, Pos0, D0), 
+			pa_datastruct__init(MainVar, ConsId, Pos1, D1), 
+			Alias = D0 - D1
+		    ), 
+		PositionPairs, 
+		Aliases). 
+			
+:- pred two_by_two(list(int)::in, pair(int)::out) is nondet. 
+two_by_two(List0, Pair):-
+	(
+		List0 = []
+	->
+		require__error("empty list")
+	; 
+		list__delete(List0, E0, Rest0), 
+		list__delete(Rest0, E1, _), 
+		(
+			E0 > E1
+		-> 
+			Pair = E1 - E0
+		; 
+			Pair = E0 - E1 
+		)
+	). 
+			
 :- pred get_rid_of_damn_typeinfos( cons_id::in, list(prog_var)::in, 
 			list(prog_var)::out) is det. 
 get_rid_of_damn_typeinfos( Cons, Args0, Args ) :- 
Index: pa_alias_as.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/pa_alias_as.m,v
retrieving revision 1.1.2.12
diff -u -r1.1.2.12 pa_alias_as.m
--- pa_alias_as.m	2001/03/07 17:20:32	1.1.2.12
+++ pa_alias_as.m	2001/03/08 18:13:51
@@ -475,14 +475,14 @@
 	remove_all_unique_vars( HLDS, Trios, NonUniqueVars), 
 	% keep only the output vars
 	collect_all_output_vars( HLDS, NonUniqueVars, OutputVars), 
-	collect_all_input_vars( HLDS, NonUniqueVars, InputVars), 
+%	collect_all_input_vars( HLDS, NonUniqueVars, InputVars), 
 	(
-		(
+%		(
 			OutputVars = [] 
-		; 
-			% XXXXXXXXXXXXXXXXX !!
-			OutputVars = [_], InputVars = []
-		)
+%		; 
+%			% XXXXXXXXXXXXXXXXX !!
+%			OutputVars = [_], InputVars = []
+%		)
 	->
 		Alias = Alias0
 	;
@@ -577,7 +577,8 @@
 		pred( P0::in ) is semidet :- 
 		(
 			P0 = trio(_, Mode, _), 
-			Mode = (_LeftInst -> RightInst), 
+			mode_util__mode_get_insts( HLDS, Mode, _LeftInst, 
+				RightInst),
 			\+ inst_is_unique(HLDS, RightInst), 
 			\+ inst_is_clobbered(HLDS, RightInst)
 		),
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------