[m-dev.] [reuse] diff: type-selector-widening + bugfix

Nancy Mazur Nancy.Mazur at cs.kuleuven.ac.be
Wed Feb 7 20:40:55 AEDT 2001


Hi,

here is a first attempt to work down the analysis time of the
alias analysis (which is part of the reuse analysis) by trying out a
new technique of widening. On first experiments this yielded quite 
some time-gain. The module tree234 used to be a real pain, taking 
upto 2 hours to get analysed and compiled. This has been reduced to 
approx. 8 minutes. At first sight, this goes without a real loss in
precision. But at least we can go on experimenting... 

I am aware that this is a huge diff, but it did require a quite
big change indeed. 

Have fun, 
Nancy


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


Estimated hours taken: 40

As the alias pass is at moments taking an indecent amount of time, we
start looking for solutions. Even with sharp optimizations, the analysis
time remained horrible (added new projection). 

This is one step towards a serious widening
operation. The widening consists of compacting the notations for the
selectors including so called type-selectors. A selector is a path
of primitive selectors. Each primitive selector used to choose a specific
position within a specific constructor. 
	e.g.  X of type tree234(K,V)
	possible selector: 
		[ (two,3), (three, 1) ]
	selecting all the keys of the subtree `three' of the subtree `tho'
	of X

Now we allow primitive selectors to designate all nodes within a 
type-tree with a specific type. 
	e.g.  still X of type tree234(K,V)
	possible selector: 
		[ K ]
	which is a shortcut notation of all the possible paths starting 
	from the top-node of X leading to nodes of type K. 

Such widening is only applied when the number of aliases at some
program point exceed a certain threshold (now 200). 

This change has an impact on the pragma's the analysis produces: 
pa_alias_info as well as sr_reuse_info contain explicit type-declarations
of each of the headvariables of a predicate. 

Next to this widening change, I also fixed a bug in the computation
of the alternating closure of two sets of aliases. 



hlds_pred.m:
	minimal change in a comment

hlds_out.m:
	Changes in the interface for handling aliases (pred_info needed). 

prog_data.m:
prog_io_pragma.m:
make_hlds.m:
modules.m:
mercury_to_mercury.m:
module_qual.m:
	The pragma pa_alias_info/3 is changed to pa_alias_as/4: it now also
	contains the type declaration of the headvariables appearing in
	the predicate. This type-information is now threaded through to the
	place where it can be used (renaming the type-variables if needed).
	Idem for the pragma sr_reuse_info. 

pa_alias_as.m:
pa_datastruct.m:
pa_selector.m:
	* As the primitive selectors can now contain types, all the
	predicates which need to go through those new primitive selectors
	need extra information (module_info --> for the type-definitions, 
	proc_info --> for knowing which variable is of what type) when handling
	or reasoning about them.
	* Next to this, new predicates for renaming aliases with respect
	to the types have been added. Renaming is taken here in a rather
	large sense, and goes more towards applying substitutions 
	(in a lot of cases we have only the type-variables that are
	being renamed). 
	* Finally, changes where made to perform the actual widening
	when needed (when the alias-sets exceed a certain threshold)

pa_alias.m:
	extra with respect to above: 
	* Bugfix: the alternating closure didn't take into account a certain
	notion of directionality when computing the new paths. 

pa_prelim_run.m:
	minor

pa_run.m:
	* When extending from a call, one has to know next to the Actual
	Arguments also the Actual types of the these arguments. These
	Actual types are needed to correctly rename the type-selectors
	occurring in the alias- and reuse-information. 
	In a next stage this renaming could be combined with filtering
	out aliases that are then obtained between primitive types
	(e.g. when aliases are obtained between integers). 
	* Output the types of each predicate in their pa_alias_info pragma.
	* Do not project unto the outbound variables, but immediately
	on the lfu+lbu variables (the variables which are truly appearing
	further on in the computation path). Some cleaning up will be
	needed here. 

pa_sr_util.m:
	New file. Contains some extra predicates which are used by the
	pa-pass, as well as the structure-reuse related modules: a
	predicate concerned with the output of
	the vars and types for the pragma's pa_alias_info and sr_reuse_info, 
	and a predicate which renames types deterministically. 

sr_data.m:
sr_dead.m:
sr_indirect.m:
sr_live.m:
sr_reuse_run.m:
sr_run.m:
structure_reuse.m:
	The data gathered during the structure-reuse pass is also in
	terms of aliases, datastructures, and therefore selectors. The
	same kind of changes where made for these files as for the pa_*
	files above:
		- thread module_info, proc_info where needed to be able
		  to handle those types
		- extra predicates for renaming the types.
	+ effects of the changes to the interface of the pa_* files
		  
typecheck.m:
	This change here, ahum, well, is apparently an ancient one I failed
	to notice to begin with. The purpose is to not spend extra time
	to typecheck reuse-versions of predicates as the basic versions
	will have been verified. 


Index: hlds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.243.2.11
diff -u -r1.243.2.11 hlds_out.m
--- hlds_out.m	2000/11/13 18:35:57	1.243.2.11
+++ hlds_out.m	2001/02/07 08:15:04
@@ -2975,7 +2975,7 @@
 		hlds_out__write_indent(Indent),
 		io__write_string("% Possible aliases: "),
 		pa_alias_as__print_maybe_possible_aliases(MaybeAliases,
-					Proc),
+					Proc, PredInfo),
 		io__nl
 	;
 		[]
Index: hlds_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.81.2.9
diff -u -r1.81.2.9 hlds_pred.m
--- hlds_pred.m	2000/11/20 10:18:04	1.81.2.9
+++ hlds_pred.m	2001/02/07 08:15:06
@@ -1653,13 +1653,7 @@
 					% of Local Forward Use in the goal)
 					% (set during structure_reuse phase)
 
-					% Set of possible reuses within
-					% the given procedure. 
-					% XXX This will
-					% become obsolete and should be
-					% replaced by our new 
-					% reuse_conditions in our new
-					% approach.
+					% Possible set of reuse conditions. 
 			structure_reuse:: maybe(list(sr_data__reuse_condition)),
 
  			need_maxfr_slot	:: bool,
Index: make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.347.2.9
diff -u -r1.347.2.9 make_hlds.m
--- make_hlds.m	2000/11/13 18:36:20	1.347.2.9
+++ make_hlds.m	2001/02/07 08:15:14
@@ -526,19 +526,21 @@
 			Module0, Module)
 	;
 		{ Pragma = pa_alias_info(PredOrFunc, SymName, ModeList,
-			HeadVars, MaybeAlias) },
+			HeadVars, Types, MaybeAlias) },
 		% these pragma's should only occur in trans_opt files. 
 		% But as this predicate is also used to read in those
 		% files, we must consider them here. 
 		% { Module = Module0 }
 		add_pragma_possible_aliases_info(PredOrFunc,SymName,ModeList,
-                                        HeadVars,MaybeAlias, Module0, Module)
+                                        HeadVars, Types, 
+					MaybeAlias, Module0, Module)
 		
 	;
 		{ Pragma = sr_reuse_info(PredOrFunc, SymName, ModeList,
-			HeadVars, Memo, MaybeReuseSymName) },
+			HeadVars, Types, Memo, MaybeReuseSymName) },
 		add_pragma_reuse_info( PredOrFunc, SymName, ModeList, 
-					HeadVars, Memo, MaybeReuseSymName,
+					HeadVars, Types, 
+					Memo, MaybeReuseSymName,
 					Module0, Module)
 	;
 		{ Pragma = terminates(Name, Arity) },
@@ -1398,16 +1400,19 @@
 
 %-----------------------------------------------------------------------------%
 
-:- pred add_pragma_possible_aliases_info( pred_or_func, sym_name, list(mode),
-		list(var(T)), maybe(alias_as),
-		module_info, module_info, 
-		io__state, io__state).
-:- mode add_pragma_possible_aliases_info( in, in, in, in, in, in, out, di, uo) 
-		is det.
+:- pred add_pragma_possible_aliases_info( 
+			pred_or_func::in, 
+			sym_name::in, 
+			list(mode)::in,
+			list(var(T))::in, 
+			list( (type) )::in, 
+			maybe(alias_as)::in,
+			module_info::in, module_info::out, 
+			io__state::di, io__state::uo) is det.
 
-add_pragma_possible_aliases_info(_, _, _, _, no, Module, Module) --> [].
+add_pragma_possible_aliases_info(_, _, _, _, _, no, Module, Module) --> [].
 add_pragma_possible_aliases_info(PredOrFunc,SymName, Modes, 
-				HeadVars, yes(AliasAS),
+				HeadVars, Types, yes(AliasAS),
 				Module0, Module) --> 
 	{ module_info_get_predicate_table(Module0, Preds) },
 	{ list__length(Modes, Arity) },
@@ -1433,7 +1438,13 @@
 			{ map__from_corresponding_lists(CHeadVars,
 				ProcHeadVars, MapHeadVars) },
 			{ pa_alias_as__rename( MapHeadVars, AliasAS, 
-						RenAliasAS) },
+						RenAliasAS0) },
+
+			% rename type variables
+			{ pred_info_arg_types( PredInfo0, ArgTypes ) }, 
+			{ pa_alias_as__rename_types( Types,
+				ArgTypes, RenAliasAS0, RenAliasAS ) }, 
+
 			{ proc_info_set_possible_aliases( ProcInfo0, 
 				RenAliasAS, ProcInfo ) },
 			{ map__det_update(ProcTable0, ProcId, ProcInfo,
@@ -1477,14 +1488,18 @@
 
 %-----------------------------------------------------------------------------%
 
-:- pred add_pragma_reuse_info( pred_or_func, sym_name, list(mode),
-		list(var(T)), sr_data__memo_reuse, maybe(sym_name),
-		module_info, module_info, 
-		io__state, io__state).
-:- mode add_pragma_reuse_info( in, in, in, in, in, in, in, out, di, uo) 
-		is det.
+:- pred add_pragma_reuse_info( 
+			pred_or_func::in, 
+			sym_name::in, 
+			list(mode)::in,
+			list(var(T))::in, 
+			list( (type) )::in, 
+			sr_data__memo_reuse::in, 
+			maybe(sym_name)::in,
+			module_info::in, module_info::out, 
+			io__state::di, io__state::uo) is det.
 
-add_pragma_reuse_info(PredOrFunc,SymName, Modes, HeadVars, TREUSE,
+add_pragma_reuse_info(PredOrFunc,SymName, Modes, HeadVars, Types, TREUSE,
 		_MaybeReuseName, Module0, Module) --> 
 	{ module_info_get_predicate_table(Module0, Preds) },
 	{ list__length(Modes, Arity) },
@@ -1510,7 +1525,11 @@
 			{ map__from_corresponding_lists(CHeadVars,
 				ProcHeadVars, MapHeadVars) },
 			{ sr_data__memo_reuse_rename( MapHeadVars, TREUSE, 
-						RenTREUSE) },
+						RenTREUSE0) },
+			{ pred_info_arg_types( PredInfo0, ArgTypes ) }, 
+			{ sr_data__memo_reuse_rename_types( Types,
+				ArgTypes, RenTREUSE0, RenTREUSE ) }, 
+
 			{ sr_split__create_reuse_pred(proc(PredId, ProcId),
 					RenTREUSE,
 					no, Module0, Module) }
Index: mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.174.2.5
diff -u -r1.174.2.5 mercury_to_mercury.m
--- mercury_to_mercury.m	2000/11/13 18:36:30	1.174.2.5
+++ mercury_to_mercury.m	2001/02/07 08:15:16
@@ -443,10 +443,10 @@
 			PredName, ModeList, Context,
 			MaybeArgSizeInfo, MaybeTerminationInfo)
 	;
-		{ Pragma = pa_alias_info(_,_,_,_,_) },
+		{ Pragma = pa_alias_info(_,_,_,_,_,_) },
 		[]
 	;
-		{ Pragma = sr_reuse_info(_,_,_,_,_, _) },
+		{ Pragma = sr_reuse_info(_,_,_,_,_,_, _) },
 		[]
 	;
 		{ Pragma = terminates(Pred, Arity) },
Index: module_qual.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.57.2.5
diff -u -r1.57.2.5 module_qual.m
--- module_qual.m	2000/11/13 18:36:51	1.57.2.5
+++ module_qual.m	2001/02/07 08:15:17
@@ -956,12 +956,16 @@
 		termination_info(PredOrFunc, SymName, ModeList, Args, Term), 
 		Info0, Info) --> 
 	qualify_mode_list(ModeList0, ModeList, Info0, Info).
-qualify_pragma(pa_alias_info(PredOrFunc, SymName, ModeList0, Vars, MaybeAS),
-		pa_alias_info(PredOrFunc, SymName, ModeList, Vars, MaybeAS),
+qualify_pragma(pa_alias_info(PredOrFunc, SymName, ModeList0, 
+			Vars, Types, MaybeAS),
+		pa_alias_info(PredOrFunc, SymName, ModeList, 
+			Vars, Types, MaybeAS),
 		Info0, Info) -->
 	qualify_mode_list(ModeList0, ModeList, Info0, Info).
-qualify_pragma(sr_reuse_info(PredOrFunc, SymName, ModeList0, Vars, TREUSE, N), 
-		sr_reuse_info(PredOrFunc, SymName, ModeList, Vars, TREUSE, N), 
+qualify_pragma(sr_reuse_info(PredOrFunc, SymName, ModeList0, Vars, 
+			Types, TREUSE, N), 
+		sr_reuse_info(PredOrFunc, SymName, ModeList, Vars, 
+			Types, TREUSE, N), 
 		Info0, Info) -->
 	qualify_mode_list(ModeList0, ModeList, Info0, Info).
 qualify_pragma(terminates(A, B), terminates(A, B), Info, Info) --> [].
Index: modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.132.2.6
diff -u -r1.132.2.6 modules.m
--- modules.m	2000/11/13 18:36:53	1.132.2.6
+++ modules.m	2001/02/07 08:15:19
@@ -1020,8 +1020,8 @@
 pragma_allowed_in_interface(unused_args(_, _, _, _, _), no).
 pragma_allowed_in_interface(type_spec(_, _, _, _, _, _, _), yes).
 pragma_allowed_in_interface(termination_info(_, _, _, _, _), yes).
-pragma_allowed_in_interface(pa_alias_info(_, _, _, _, _), yes).
-pragma_allowed_in_interface(sr_reuse_info(_, _, _, _, _, _), yes).
+pragma_allowed_in_interface(pa_alias_info(_, _, _, _, _,_), yes).
+pragma_allowed_in_interface(sr_reuse_info(_, _, _, _, _, _,_), yes).
 pragma_allowed_in_interface(terminates(_, _), yes).
 pragma_allowed_in_interface(does_not_terminate(_, _), yes).
 pragma_allowed_in_interface(check_termination(_, _), yes).
Index: pa_alias.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/pa_alias.m,v
retrieving revision 1.1.2.2
diff -u -r1.1.2.2 pa_alias.m
--- pa_alias.m	2000/09/27 15:00:17	1.1.2.2
+++ pa_alias.m	2001/02/07 08:15:19
@@ -53,8 +53,8 @@
 */
 
 	% aliased_to( AL, D1, D2) such that AL = D1 - D2
-:- pred aliased_to( alias, datastruct, datastruct ).
-:- mode aliased_to( in, in, out) is semidet.
+:- pred aliased_to( module_info, proc_info, alias, datastruct, datastruct ).
+:- mode aliased_to( in, in, in, in, out) is semidet.
 
 	% Rename the variables of the alias using the given mapping. 
 :- pred rename( map(prog_var, prog_var), alias, alias).
@@ -65,6 +65,9 @@
 :- mode rename_alias( in, in, in, out) is det.
 */
 
+:- pred rename_types( term__substitution(tvar_type)::in, 
+			alias::in, alias::out) is det.
+
 	% Check whether a given alias is a member of the given list. 
 :- pred occurs_in( alias, list(alias)).
 :- mode occurs_in( in, in ) is semidet.
@@ -150,8 +153,9 @@
 :- mode extend_prog_var_from_alias( in, in, in, out) is det.
 
 	% printing routines
-:- pred print( proc_info, string, string, alias, io__state, io__state).
-:- mode print( in, in, in, in, di, uo) is det.
+:- pred print( proc_info, pred_info, string, string, 
+			alias, io__state, io__state).
+:- mode print( in, in, in, in, in, di, uo) is det.
 
 	% parsing routines
 :- pred parse_term( term(T), alias).
@@ -160,8 +164,14 @@
 :- pred live_from_in_use(set(prog_var), list(alias), live_set).
 :- mode live_from_in_use(in, in, out) is det.
 
-:- pred live_from_live0(live_set, list(alias), live_set).
-:- mode live_from_live0(in, in, out) is det.
+:- pred live_from_live0(module_info, proc_info, 
+				live_set, list(alias), live_set).
+:- mode live_from_live0(in, in, in, in, out) is det.
+
+:- pred apply_widening( module_info::in, proc_info::in, alias::in, 
+		alias::out) is det.
+:- pred apply_widening_list( module_info::in, proc_info::in, list(alias)::in,
+		list(alias)::out) is det.
 
 %-------------------------------------------------------------------%
 %-------------------------------------------------------------------%
@@ -202,13 +212,13 @@
 % printing routines
 %-------------------------------------------------------------------%
 
-print( ProcInfo, FrontString, EndString, ALIAS ) -->
+print( ProcInfo, PredInfo, FrontString, EndString, ALIAS ) -->
 	{ ALIAS = D1 - D2 },
 	io__write_string( FrontString ),
 	io__write_string( "pair( " ),
-	pa_datastruct__print( D1, ProcInfo ),
+	pa_datastruct__print( D1, ProcInfo, PredInfo ),
 	io__write_string(" , "),
-	pa_datastruct__print( D2, ProcInfo ),
+	pa_datastruct__print( D2, ProcInfo, PredInfo ),
 	io__write_string(" ) "),
 	io__write_string( EndString ).
 
@@ -271,14 +281,16 @@
 	pa_datastruct__get_var(Data2, Var2),
 	( list__member(Var1, Vars);  list__member(Var2, Vars)).
 	
-aliased_to( Alias, Data1, Data2 ) :-
+aliased_to( ModuleInfo, ProcInfo, Alias, Data1, Data2 ) :-
 	Alias = D1 - D2,
 	(
-		pa_datastruct__less_or_equal(Data1, D1, EXT)
+		pa_datastruct__less_or_equal(ModuleInfo, ProcInfo, 
+						Data1, D1, EXT)
 	->
 		pa_datastruct__termshift(D2, EXT, Data2)
 	;
-		pa_datastruct__less_or_equal(Data1, D2, EXT)
+		pa_datastruct__less_or_equal(ModuleInfo, ProcInfo, 
+						Data1, D2, EXT)
 	->
 		pa_datastruct__termshift(D1, EXT, Data2)
 	;
@@ -319,6 +331,12 @@
 	pa_datastruct__rename( MAP, Data2, RData2),
 	RAlias = RData1 - RData2. 
 
+rename_types( Subst, Alias0, Alias ):-
+	Alias0 = Data10 - Data20, 
+	pa_datastruct__rename_types( Subst, Data10, Data1), 
+	pa_datastruct__rename_types( Subst, Data20, Data2), 
+	Alias = Data1 - Data2.
+
 occurs_in( A2, [A1 | R ] ):-
 	(
 		pa_alias__equal(A1,A2)
@@ -349,13 +367,13 @@
 	).
 
 
-less_or_equal( _ProcInfo, _HLDS, A1, A2 ) :-
+less_or_equal( ProcInfo, HLDS, A1, A2 ) :-
 	A1 = D1a - D1b,
 	A2 = D2a - D2b,
 	(
 		% XXX TEST underscored extensions!
-		pa_datastruct__less_or_equal(D1a,D2a, EXT1),
-		pa_datastruct__less_or_equal(D1b,D2b, EXT1)
+		pa_datastruct__less_or_equal(HLDS, ProcInfo, D1a,D2a, EXT1),
+		pa_datastruct__less_or_equal(HLDS, ProcInfo, D1b,D2b, EXT1)
 		% the extension should be the same wrt normalization
 		% normalize(D1b.EXT1) == normalize(D1b.EXT2) 
 		% where normalize(D1b.EXT2) == D2b as D2b is a normalized
@@ -370,8 +388,8 @@
 		% at the end. 
 	;
 		% XXX TEST underscored extensions!
-		pa_datastruct__less_or_equal(D1a,D2b, EXT1),
-		pa_datastruct__less_or_equal(D1b,D2a, EXT1)
+		pa_datastruct__less_or_equal(HLDS, ProcInfo, D1a,D2b, EXT1),
+		pa_datastruct__less_or_equal(HLDS, ProcInfo, D1b,D2a, EXT1)
 	).
 
 
@@ -395,8 +413,9 @@
 	list__foldl(pa_alias__add_subsuming(ProcInfo, HLDS), 
 			L1, L2, L).
 
-extend( ProcInfo, HLDS, OLD, NEW, RESULT) :-
-	alias_altclosure( ProcInfo, HLDS, NEW, OLD, RESULT).
+extend( ProcInfo, HLDS, NEW, OLD,  RESULT) :-
+% 	alias_altclosure( ProcInfo, HLDS, NEW, OLD, RESULT).
+	altclosure_altclos( HLDS, ProcInfo, NEW, OLD, RESULT). 
 
 	% alias_altclosure( NEW, OLD, RESULT)
 	% computes the alternating closure of two lists of aliases.
@@ -511,6 +530,165 @@
 		fail
 	).
 
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- type altclos_path ---> single(alias)		% can be rotated
+			; compressed(alias).	% fixed order: shortcut of
+						% path(alias, ... , alias)
+
+:- pred alias_to_altclos_path(alias::in, altclos_path::out) is det.
+alias_to_altclos_path(Alias, single(Alias)). 
+
+:- pred altclos_path_to_alias(altclos_path::in, alias::out) is det.
+altclos_path_to_alias( single(Alias), Alias ).
+altclos_path_to_alias( compressed(Alias), Alias ). 
+
+%-----------------------------------------------------------------------------%
+
+% altclos computations. 
+
+:- pred altclosure_altclos( module_info::in, proc_info::in, 
+			list(alias)::in, list(alias)::in, 
+			list(alias)::out ) is det.
+altclosure_altclos( ModuleInfo, ProcInfo, NewAliases, OldAliases,
+			ComputedAliases ):-
+	(
+		NewAliases = []
+	->
+		ComputedAliases = OldAliases
+	;
+		OldAliases = []
+	-> 
+		ComputedAliases = NewAliases
+	; 
+		altclosure_altclos_path2_3( NewAliases, OldAliases, 
+			Path2, Path3), 
+		list__foldl(
+			pa_alias__least_upper_bound_lists(ProcInfo, ModuleInfo),
+				[OldAliases,NewAliases,Path2,Path3],
+				[],
+				ComputedAliases)
+	).
+
+	% altclosure_altclos_path2_3( NewAliases, OldAliases, Path2, Path3)
+:- pred altclosure_altclos_path2_3( list(alias)::in, list(alias)::in, 
+		list(alias)::out, list(alias)::out) is det.
+altclosure_altclos_path2_3( NewAliases, OldAliases, Path2, Path3):- 
+	list__map( alias_to_altclos_path, NewAliases, StartPaths ), 
+	list__foldl( 
+		pred( StartPath::in, Acc::in, NewPaths::out) is det :-
+		    (
+			altclos_ordered_altclos_path( StartPath, 
+				OldAliases, Acc, NewPaths)
+		    ),
+		StartPaths, 
+		[],
+		PathsLength2 ), 
+	list__foldl(
+		pred( StartPath::in, Acc::in, NewPaths::out) is det :-
+		    (
+			altclos_ordered_altclos_path( StartPath,
+				NewAliases, Acc, NewPaths)
+		    ),
+		PathsLength2,
+		[],
+		PathsLength3), 
+	list__map( altclos_path_to_alias, PathsLength2, Path2),
+	list__map( altclos_path_to_alias, PathsLength3, Path3).
+
+:- pred altclos_ordered_altclos_path( altclos_path::in, list(alias)::in, 
+		list(altclos_path)::in, list(altclos_path)::out) is det.
+altclos_ordered_altclos_path( StartPath, EndAliases, AccPaths, NewPaths):- 
+	list__filter_map(single_altclos_path( StartPath ), 
+				EndAliases, NewPaths0 ),
+	list__append( NewPaths0, AccPaths, NewPaths). 
+
+	% single_altclos_path( StartPath, EndAlias, NewPath). 
+	% Find a path starting from StartPath and ending in EndAlias. 
+	% EndAlias can always be rotated. StartPath can only be
+	% rotated if it is a single path. 
+:- pred single_altclos_path( altclos_path::in, alias::in, 
+		altclos_path::out) is semidet.
+single_altclos_path( StartPath, EndAlias, NewPath) :- 
+	(
+		StartPath = single(StartAlias)
+	-> 
+		( 
+			single_directed_altclos_path_verify(StartAlias,
+				EndAlias, NewPath0)
+		->
+			NewPath = NewPath0
+		; 
+			switch(StartAlias, StartAliasSW),
+			single_directed_altclos_path_verify(StartAliasSW, 
+				EndAlias, NewPath)
+		)
+	;
+		StartPath = compressed(StartAlias),
+		single_directed_altclos_path_verify(StartAlias, 
+			EndAlias, NewPath)
+	).
+
+	% single_directed_altclos_path_verify( StartAlias, EndAlias, NewPath).
+	% Compute a path starting from StartAlias to EndAlias. StartAlias
+	% may not be rotated. EndAlias can be rotated if needed. The middle
+	% alias still has to be verified. 
+:- pred single_directed_altclos_path_verify( alias::in, alias::in, 
+		altclos_path::out) is semidet.
+single_directed_altclos_path_verify( StartAlias, EndAlias, Path ) :- 
+	StartAlias = _StartDatastructure1 - StartDatastructure2, 
+	EndAlias = EndDatastructure1 - EndDatastructure2, 
+	(
+		pa_datastruct__same_vars( StartDatastructure2,
+					EndDatastructure1)
+	->
+		single_directed_altclos_path( StartAlias, EndAlias, 
+				Path)
+	; 
+		pa_datastruct__same_vars( StartDatastructure2, 
+					EndDatastructure2), 
+		switch( EndAlias, EndAliasSW ), 
+		single_directed_altclos_path( StartAlias, EndAliasSW, 
+				Path)
+	).
+
+	% single_directed_altclos_path( StartAlias, EndAlias, NewPath).
+	% they already have matching middle vars. 
+:- pred single_directed_altclos_path( alias::in, alias::in, 
+			altclos_path::out) is semidet.
+single_directed_altclos_path( StartAlias, EndAlias, NewPath):-
+	StartAlias = StartDatastructure1 - StartDatastructure2, 
+	EndAlias = EndDatastructure1 - EndDatastructure2, 
+	pa_datastruct__get_selector(StartDatastructure2, StartSelector), 
+	pa_datastruct__get_selector(EndDatastructure1, EndSelector), 
+	(
+		% either EndSelector <= StartSelector
+		pa_selector__less_or_equal(EndSelector, StartSelector, Ext)
+	-> 
+		% StartSelector.Ext = EndSelector, and StartAlias has
+		% to be termshifted:
+		pa_datastruct__termshift(StartDatastructure1, Ext, 
+				NewStartDatastructure1),
+		NewPath = compressed( NewStartDatastructure1 -  
+				EndDatastructure2 )
+	;
+		% or StartSelector <= EndSelector
+		pa_selector__less_or_equal(StartSelector, EndSelector, Ext)
+	->
+		% EndSelector.Ext = StartSelector, and EndAlias has to
+		% be termshifted:
+		pa_datastruct__termshift(EndDatastructure2, Ext, 
+				NewEndDatastructure2), 
+		NewPath = compressed(StartDatastructure1 - NewEndDatastructure2)
+	;
+		fail
+	).
+
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
 :- pred number_args( list(prog_var), list(pair(int, prog_var))).
 :- mode number_args( in, out) is det.
 
@@ -692,9 +870,9 @@
 
 switch( D1 - D2, D2 - D1 ).
 	
-%-------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
 % NORMALIZATION WITH TYPE INFORMATION
-%-------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
 
 normalize_wti(ProcInfo, HLDS, A0, A):-
 	A0 = Da0 - Db0,
@@ -702,8 +880,8 @@
 	pa_datastruct__normalize_wti(ProcInfo, HLDS, Db0, Db),
 	A = Da - Db.
 
-%-------------------------------------------------------------------%
-%-------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
 
 live_from_in_use(IN_USE, ALIASES, LIVE):-
 	% filter the list of aliases, keeping only the ones that 
@@ -714,7 +892,7 @@
 		DATASTRUCTS),
 	sr_live__from_datastructs(DATASTRUCTS, LIVE).
 
-live_from_live0(LIVE_0, ALIASES, LIVE):- 
+live_from_live0(ModuleInfo, ProcInfo, LIVE_0, ALIASES, LIVE):- 
 	(
 		(sr_live__top(LIVE_0) ; sr_live__bottom(LIVE_0))
 	->
@@ -722,7 +900,8 @@
 	;
 		sr_live__get_datastructs(LIVE_0, Datastructs),
 		list__map(
-			pa_alias__one_of_vars_is_live(Datastructs),
+			pa_alias__one_of_vars_is_live(ModuleInfo,
+				ProcInfo, Datastructs),
 			ALIASES,
 			LL_DATASTRUCTS), 
 		list__condense(LL_DATASTRUCTS, DATASTRUCTS),
@@ -736,23 +915,25 @@
 	%		sy = s1.s2 => sx1 = sx
 	% 	   or
 	%		sy.s2 = s1 => sx1 = sx.s2
-:- pred one_of_vars_is_live(list(pa_datastruct__datastruct), 
+:- pred one_of_vars_is_live(module_info, proc_info, 
+				list(pa_datastruct__datastruct), 
 				alias, 
 				list(pa_datastruct__datastruct)).
-:- mode one_of_vars_is_live(in, in, out) is det.
+:- mode one_of_vars_is_live(in, in, in, in, out) is det.
 
-one_of_vars_is_live(LIST, ALIAS, List_Xsx1) :- 
-	one_of_vars_is_live_ordered(LIST, ALIAS, L1), 
+one_of_vars_is_live(ModuleInfo, ProcInfo, LIST, ALIAS, List_Xsx1) :- 
+	one_of_vars_is_live_ordered(ModuleInfo, ProcInfo, LIST, ALIAS, L1), 
 	switch(ALIAS, ALIASsw),	
-	one_of_vars_is_live_ordered(LIST, ALIASsw, L2),
+	one_of_vars_is_live_ordered(ModuleInfo, ProcInfo, LIST, ALIASsw, L2),
 	list__append(L1,L2, List_Xsx1).
 
-:- pred one_of_vars_is_live_ordered( list(pa_datastruct__datastruct),
+:- pred one_of_vars_is_live_ordered( module_info, proc_info,
+				list(pa_datastruct__datastruct),
 				alias,
 				list(pa_datastruct__datastruct) ).
-:- mode one_of_vars_is_live_ordered( in, in, out) is det.
+:- mode one_of_vars_is_live_ordered( in, in, in, in, out) is det.
 
-one_of_vars_is_live_ordered( LIST, ALIAS, List_Xsx1 ) :- 
+one_of_vars_is_live_ordered( ModuleInfo, ProcInfo, LIST, ALIAS, List_Xsx1 ) :- 
 	ALIAS = Xsx - Ysy,
 	pa_datastruct__get_var(Ysy, Y),
 	list__filter( 
@@ -766,7 +947,8 @@
 		% Ys1 in Y_LIST (sy = s1.s2)
 		list__filter(
 			pred( Ys1::in ) is semidet :-
-			    ( pa_datastruct__less_or_equal(Ysy, Ys1, _s2) ),
+			    ( pa_datastruct__less_or_equal( ModuleInfo, 
+					ProcInfo, Ysy, Ys1, _s2) ),
 			Y_LIST,
 			FY_LIST),
 		FY_LIST = [_|_]
@@ -781,7 +963,8 @@
 		% is not minimal, while this should be somehow guaranteed).
 		list__filter_map(
 			pred( Ys1::in, S2::out) is semidet :-
-			    ( pa_datastruct__less_or_equal(Ysy, Ys1, S2)),
+			    ( pa_datastruct__less_or_equal( ModuleInfo, 
+					ProcInfo, Ysy, Ys1, S2)),
 			Y_LIST,
 			SELECTOR_LIST),
 		% each sx1 = sx.s2, where s2 is one of SELECTOR_LIST
@@ -792,3 +975,26 @@
 			List_Xsx1 )
 	).
 			
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+apply_widening( ModuleInfo, ProcInfo, Alias0, Alias) :-
+	Alias0 = Da0 - Db0, 
+	apply_widening( ModuleInfo, ProcInfo, Da0, Da), 
+	apply_widening( ModuleInfo, ProcInfo, Db0, Db), 
+	Alias = Da - Db. 
+
+apply_widening_list(ModuleInfo, ProcInfo, AliasList0, AliasList) :- 
+	list__foldl(
+		pred( Alias0::in, List0::in, List::out ) is det :- 
+		    (
+			apply_widening( ModuleInfo, ProcInfo, Alias0, 
+					Alias), 
+			add_subsuming(ProcInfo, ModuleInfo, Alias, 
+					List0, List )
+		    ),
+		AliasList0, 
+		[],
+		AliasList ). 
+		
+
Index: pa_alias_as.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/pa_alias_as.m,v
retrieving revision 1.1.2.8
diff -u -r1.1.2.8 pa_alias_as.m
--- pa_alias_as.m	2000/11/23 15:02:37	1.1.2.8
+++ pa_alias_as.m	2001/02/07 08:15:20
@@ -54,9 +54,10 @@
 	% Collect all the datastructures to which the datastructure
 	% is aliased, taking into account possible termshifting.
 	% Gives an error when alias_as is top.
-:- pred collect_aliases_of_datastruct(pa_datastruct__datastruct, 
+:- pred collect_aliases_of_datastruct(module_info, proc_info, 
+		pa_datastruct__datastruct, 
 		alias_as, list(pa_datastruct__datastruct)).
-:- mode collect_aliases_of_datastruct(in, in, out) is det.
+:- mode collect_aliases_of_datastruct(in, in, in, in, out) is det.
 
 	% extend_prog_vars_from_alias( Vars, Alias, NewVars)
 	% ( X \in NewVars <=> X \in Vars or alias(X,Y) \in Alias and
@@ -69,6 +70,17 @@
 :- pred rename( map(prog_var, prog_var), alias_as, alias_as).
 :- mode rename( in, in, out ) is det.
 
+	% rename_types( FromTypes, ToTypes, Alias0, Alias).
+	% Rename all the typevariables occurring in the aliases using the
+	% mapping from FromTypes to ToTypes. 
+:- pred rename_types( list( (type) )::in, list( (type) )::in, 
+		alias_as::in, alias_as::out ) is det.
+	% rename_types( Substitution, Alias0, Alias). 
+	% Rename all the type-variables occurring in the aliases using the
+	% substitution mapping. 
+:- pred rename_types( term__substitution( tvar_type )::in, 
+		alias_as::in, alias_as::out ) is det.
+
 	% returns true if both abstract substitutions are equal. 
 	% needed for fixpoint
 :- pred equal( alias_as, alias_as).
@@ -89,8 +101,10 @@
 					list(alias_as), alias_as).
 :- mode least_upper_bound_list( in, in, in, in, out) is det.
 
-	% extend( NEW, OLD, RESULT).
+	% extend( ProcInfo, ModuleInfo, NEW, OLD, RESULT).
 	% extend a given abstract substitution with new information.
+	% NB: the order is _very_ important! The first alias-set is
+	% the (new) one to be added to the second one (cumulating one). 
 :- pred extend( proc_info, module_info, alias_as, alias_as, alias_as).
 :- mode extend( in, in, in, in, out) is det.
 
@@ -121,18 +135,18 @@
 	% print-procedures:
 	% print_maybe_possible_aliases: routine used within
 	% hlds_dumps.
-:- pred print_maybe_possible_aliases( maybe(alias_as), proc_info,
+:- pred print_maybe_possible_aliases( maybe(alias_as), proc_info, pred_info, 
 				io__state, io__state).
-:- mode print_maybe_possible_aliases( in, in, di, uo) is det.
+:- mode print_maybe_possible_aliases( in, in, in, di, uo) is det.
 
 	% print_maybe_interface_aliases: routine for printing
 	% alias information in interface files.
 :- pred print_maybe_interface_aliases( maybe(alias_as), 
-				proc_info, io__state, io__state).
-:- mode print_maybe_interface_aliases( in, in, di, uo) is det.
+				proc_info, pred_info, io__state, io__state).
+:- mode print_maybe_interface_aliases( in, in, in, di, uo) is det.
 
-:- pred print_aliases( alias_as, proc_info, io__state, io__state).
-:- mode print_aliases( in, in, di, uo) is det.
+:- pred print_aliases( alias_as, proc_info, pred_info, io__state, io__state).
+:- mode print_aliases( in, in, in, di, uo) is det.
 
 	% reverse routine of print_maybe_interface_aliases.
 :- pred parse_read_aliases(list(term(T)), alias_as).
@@ -144,11 +158,13 @@
 	% Live = live(IN_USE,LIVE_0,ALIASES).
 	% compute the live-set based upon an initial IN_USE set, 
 	% and a list of aliases.
-:- pred live(set(prog_var),live_set, alias_as, sr_live__live_set).
-:- mode live(in,in, in,out) is det.
-
-:- func live(set(prog_var),live_set, alias_as) = sr_live__live_set.
-:- mode live(in,in, in) = out is det.
+:- pred live(module_info, proc_info, 
+		set(prog_var),live_set, alias_as, sr_live__live_set).
+:- mode live(in, in, in,in, in,out) is det.
+
+:- func live(module_info, proc_info, 
+		set(prog_var),live_set, alias_as) = sr_live__live_set.
+:- mode live(in, in, in,in, in) = out is det.
 
 :- func size( alias_as ) = int.
 :- mode size( in ) = out is det.
@@ -158,10 +174,10 @@
 :- implementation.
 
 % library modules
-:- import_module require, term.
+:- import_module require, term, assoc_list.
 
 % compiler modules
-:- import_module pa_alias, pa_util.
+:- import_module pa_alias, pa_util, pa_sr_util.
 
 %-----------------------------------------------------------------------------%
 %-- type definitions 
@@ -178,8 +194,8 @@
 :- func alias_limit = int. 
 :- func top_limit = int. 
 
-alias_limit = 100.
-top_limit = 1000.
+alias_limit = 500. % 100
+top_limit = 200.
 
 %-----------------------------------------------------------------------------%
 
@@ -243,13 +259,14 @@
 	set__to_sorted_list( SetVar, ListVar),
 	project( ListVar, ASin, ASout).
 
-collect_aliases_of_datastruct( DATA, AS, LIST ):-
+collect_aliases_of_datastruct( ModuleInfo, ProcInfo, DATA, AS, LIST ):-
 	(
 		AS = real_as(ALIASES)
 	->
 		list__filter_map(
 			pred( A::in, D::out) is semidet :-
-			    ( pa_alias__aliased_to( A, DATA, D)),
+			    ( pa_alias__aliased_to( ModuleInfo, ProcInfo, 
+					A, DATA, D)),
 			ALIASES,
 			LIST)
 	;
@@ -298,6 +315,27 @@
 		ASout = ASin 
 	).
 
+rename_types( FromTypes, ToTypes, ASin, ASout ) :- 
+	assoc_list__from_corresponding_lists( FromTypes, ToTypes, 
+				FromToTypes ), 
+	list__foldl( rename_type_det, FromToTypes, 
+				map__init, Substitution), 
+	rename_types( Substitution, ASin, ASout ). 
+
+rename_types( Substitution, A0, A) :- 
+	(
+		A0 = real_as( Aliases0 )
+	-> 
+		list__map(
+			pa_alias__rename_types(Substitution), 
+			Aliases0, 
+			Aliases ), 
+		A = real_as( Aliases )
+	; 
+		A = A0
+	).
+			
+
 equal( AS1, AS2 ):-
 	(
 		AS1 = real_as(LIST1)
@@ -342,7 +380,7 @@
 		->
 			pa_alias__least_upper_bound_lists(ProcInfo, 
 				HLDS, LIST1,LIST2,Aliases),
-			wrap(Aliases, RESULT)
+			wrap_and_control( HLDS, ProcInfo, Aliases, RESULT)
 		;
 			AS2 = top(_)
 		->
@@ -376,7 +414,7 @@
 	->
 		pa_alias__least_upper_bound_lists(ProcInfo,HLDS,
 				LIST,[],Aliases),
-		wrap(Aliases,RESULT)
+		wrap_and_control(HLDS, ProcInfo, Aliases,RESULT)
 	;
 		% AS is bottom or top(_)
 		RESULT = AS
@@ -402,13 +440,17 @@
 		Alias0 = bottom, 
 		Alias = Alias0
 	; 
-		Alias0 = real_as(_), 
+		Alias0 = real_as(AliasList0), 
+		SIZE = size(Alias0), 
 		(
-			size(Alias0) > top_limit
+			SIZE > top_limit
 		->
-			top("Size too big", Alias)
+			pa_alias__apply_widening_list( HLDS, ProcInfo, 
+				AliasList0, AliasList ), 
+			Alias = real_as(AliasList)
+			% top("Size too big", Alias)
 		;
-			size(Alias0) > alias_limit
+			SIZE > alias_limit
 		-> 
 			normalize_with_goal_info( ProcInfo, HLDS, GoalInfo, 
 				Alias0, Alias)
@@ -425,8 +467,8 @@
 			A2 = real_as(OLD)
 		->
 			pa_alias__extend(ProcInfo, HLDS, 
-				OLD, NEW, Aliases),
-			wrap(Aliases,RESULT)
+				NEW, OLD, Aliases),
+			wrap_and_control(HLDS, ProcInfo, Aliases, RESULT)
 		;
 			A2 = top(_)
 		->
@@ -695,26 +737,27 @@
 
 	% MaybeAs = yes( Alias_as) -> print out Alias_as
 	%         = no		   -> print "not available"
-print_maybe_possible_aliases( MaybeAS, ProcInfo ) -->
+print_maybe_possible_aliases( MaybeAS, ProcInfo, PredInfo ) -->
 	(
 		{ MaybeAS = yes(AS) }
 	->	
-		print_possible_aliases( AS, ProcInfo)
+		print_possible_aliases( AS, ProcInfo, PredInfo)
 	;
 		io__write_string("% not available.")
 	).
 
 	% print_possible_aliases( Abstract Substitution, Proc Info).
 	% print alias abstract substitution
-:- pred print_possible_aliases( alias_as, proc_info, io__state, io__state).
-:- mode print_possible_aliases( in, in, di, uo ) is det. 
+:- pred print_possible_aliases( alias_as, proc_info, pred_info, 
+					io__state, io__state).
+:- mode print_possible_aliases( in, in, in, di, uo ) is det. 
 
-print_possible_aliases( AS, ProcInfo ) -->
+print_possible_aliases( AS, ProcInfo, PredInfo ) -->
 	(
 		{ AS = real_as(Aliases) }
 	->
 		io__write_list( Aliases, "", 
-			pa_alias__print(ProcInfo,"% ", "\n"))
+			pa_alias__print(ProcInfo, PredInfo, "% ", "\n"))
 	;
 		{ AS = top(Msgs) }
 	->
@@ -731,24 +774,24 @@
 
 	% MaybeAs = yes(Alias_as) -> print `yes( printed Alias_as)'
 	%         = no		  -> print `not_available'
-print_maybe_interface_aliases( MaybeAS, ProcInfo ) -->
+print_maybe_interface_aliases( MaybeAS, ProcInfo, PredInfo ) -->
 	(
 		{ MaybeAS = yes(AS) }
 	->
 		io__write_string("yes("),
-		print_aliases(AS, ProcInfo),
+		print_aliases(AS, ProcInfo, PredInfo),
 		io__write_string(")")
 	;
 		io__write_string("not_available")
 	).
 
-print_aliases( AS, ProcInfo ) --> 
+print_aliases( AS, ProcInfo, PredInfo ) --> 
 	(
 		{ AS = real_as(Aliases) }
 	->
 		io__write_string("["),
 		io__write_list( Aliases, ",", 
-			pa_alias__print(ProcInfo," ","")),
+			pa_alias__print(ProcInfo,PredInfo," ","")),
 		io__write_string("]")
 	;
 		{ AS = top(_Msgs) }
@@ -848,19 +891,41 @@
 	->
 		AS = bottom
 	;
-		list__length(LIST,Length), 
+%		list__length(LIST,Length), 
+%		Length > top_limit
+%	->
+%		top("Size too big", AS)
+%	;
+		AS = real_as(LIST)
+	).
+
+:- pred wrap_and_control( module_info::in, proc_info::in, 
+				list(alias)::in, alias_as::out) is det.
+
+wrap_and_control( _ModuleInfo, _ProcInfo, AliasList, AS ):-
+	wrap( AliasList, AS ).
+/**
+	(
+		AliasList = []
+	->
+		AS = bottom
+	; 
+		list__length(AliasList,Length),
 		Length > top_limit
 	->
-		top("Size too big", AS)
+		pa_alias__apply_widening_list( ModuleInfo, ProcInfo, 
+				AliasList, AliasList1 ), 
+		AS = real_as( AliasList1 )
 	;
-		AS = real_as(LIST)
+		AS = real_as( AliasList )
 	).
+**/
 
 
 %-------------------------------------------------------------------%
 % computing LIVE_SET
 %-------------------------------------------------------------------%
-live(IN_USE, LIVE_0, AS, LIVE) :-
+live(ModuleInfo, ProcInfo, IN_USE, LIVE_0, AS, LIVE) :-
 	(
 		set__empty(IN_USE)
 	->
@@ -885,7 +950,7 @@
 		% most general case
 		AS = real_as(Aliases)
 	->
-		live_2(IN_USE, LIVE_0, Aliases, LIVE)
+		live_2(ModuleInfo, ProcInfo, IN_USE, LIVE_0, Aliases, LIVE)
 	;
 		error("(pa_alias_as) live: impossible situation.")	
 	).
@@ -893,11 +958,11 @@
 
 	% live_2(IN_USE, Aliases, Liveset)
 	% pre-condition: IN_USE is not empty
-:- pred live_2(set(prog_var),sr_live__live_set,
+:- pred live_2(module_info, proc_info, set(prog_var),sr_live__live_set,
 		list(pa_alias__alias), sr_live__live_set).
-:- mode live_2(in, in, in, out) is det.
+:- mode live_2(in, in, in, in, in, out) is det.
 
-live_2( IN_USE, LIVE_0, ALIASES, LIVE) :- 
+live_2( ModuleInfo, ProcInfo, IN_USE, LIVE_0, ALIASES, LIVE) :- 
 	% LIVE = LIVE0 + LIVE1 + LIVE2 + LIVE3
 	% where
 	%	LIVE0 = LIVE_0
@@ -929,13 +994,14 @@
 	pa_alias__live_from_in_use(IN_USE, ALIASES, LIVE2),
 
 	% (LIVE3)
-	pa_alias__live_from_live0(LIVE_0, ALIASES, LIVE3),
+	pa_alias__live_from_live0(ModuleInfo, ProcInfo, 
+			LIVE_0, ALIASES, LIVE3),
 
 	% LIVE
 	sr_live__union([LIVE0,LIVE1,LIVE2,LIVE3],LIVE).
 
 
-live(IN_USE, LIVE_0, AS) = LIVE :- 
-	live(IN_USE, LIVE_0, AS, LIVE).
+live(ModuleInfo, ProcInfo, IN_USE, LIVE_0, AS) = LIVE :- 
+	live(ModuleInfo, ProcInfo, IN_USE, LIVE_0, AS, LIVE).
 
 
Index: pa_datastruct.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/pa_datastruct.m,v
retrieving revision 1.1.2.1
diff -u -r1.1.2.1 pa_datastruct.m
--- pa_datastruct.m	2000/09/19 10:02:07	1.1.2.1
+++ pa_datastruct.m	2001/02/07 08:15:20
@@ -66,8 +66,8 @@
 	% Check whether by extending the ShorterData with some selector
 	% Selector one can obtain LongerData. 
 	% If the datastructs concern different variables, fail right away.
-:- pred less_or_equal(datastruct, datastruct, selector).
-:- mode less_or_equal(in, in, out) is semidet.
+:- pred less_or_equal(module_info, proc_info, datastruct, datastruct, selector).
+:- mode less_or_equal(in, in, in, in, out) is semidet.
 
 	% Check whether the two given datastructs are related to the
 	% same variable or not. 
@@ -82,9 +82,12 @@
 :- pred rename(map(prog_var,prog_var), datastruct, datastruct).
 :- mode rename(in, in, out) is det.
 
+:- pred rename_types( term__substitution(tvar_type)::in, 
+			datastruct::in, datastruct::out) is det. 
+
 	% Printing routines
-:- pred print(datastruct, proc_info, io__state, io__state).
-:- mode print(in, in, di, uo) is det.
+:- pred print(datastruct, proc_info, pred_info, io__state, io__state).
+:- mode print(in, in, in, di, uo) is det.
 
 	% Parsing routines
 :- pred parse_term( term(T), datastruct ).
@@ -93,6 +96,9 @@
 :- pred normalize_wti(proc_info, module_info, datastruct, datastruct).
 :- mode normalize_wti(in, in, in, out) is det.
 
+:- pred apply_widening( module_info::in, proc_info::in, datastruct::in, 
+			datastruct::out) is det.
+
 %-------------------------------------------------------------------%
 %-------------------------------------------------------------------%
 :- implementation.
@@ -114,14 +120,22 @@
 	map__lookup( MAP, VAR, RVAR),
 	DATAout = cel(RVAR, SEL).
 
+rename_types( Subst, Data0, Data) :- 
+	Data0 = cel( Var, Sel0), 
+	pa_selector__rename_types( Subst, Sel0, Sel), 
+	Data = cel( Var, Sel). 
+
 equal( D1, D2 ):- D1 = D2.
 
 same_vars(D1, D2):-
 	get_var(D1,V),
 	get_var(D2,V).
 
-less_or_equal(D1,D2, EXT):-
+less_or_equal(ModuleInfo, ProcInfo, D1,D2, EXT):-
 	same_vars(D1,D2),
+	get_var(D1,ProgVar), 
+	proc_info_vartypes(ProcInfo, VarTypes), 
+	map__lookup( VarTypes, ProgVar, ProgVarType), 
 	(
 		equal(D1,D2)
 	->
@@ -129,7 +143,7 @@
 	;
 		get_selector(D1,S1),
 		get_selector(D2,S2),
-		pa_selector__less_or_equal(S1,S2, EXT)
+		pa_selector__less_or_equal(ModuleInfo,S1,S2,ProgVarType,EXT)
 	).
 
 termshift(Din, S, Dout):-
@@ -145,14 +159,15 @@
 	SEL = [],
 	Dout = cel(V, SEL).
 
-print( D, ProcInfo) -->
+print( D, ProcInfo, PredInfo) -->
 	{ D = cel( ProgVar, SEL ) },
 	{ proc_info_varset(ProcInfo, ProgVarset) },
 	{ varset__lookup_name( ProgVarset, ProgVar, ProgName ) },
 	io__write_string("cel("),
 	io__write_string( ProgName ), 
 	io__write_string(", "),
-	pa_selector__print(SEL),
+	{ pred_info_typevarset( PredInfo, TypeVarSet ) }, 
+	pa_selector__print(SEL, TypeVarSet),
 	io__write_string(")").
 
 parse_term( TERM, Data ) :- 
@@ -212,4 +227,12 @@
 		D = cel( ProgVar, SEL )
 	).
 
+apply_widening( ModuleInfo, ProcInfo, D0, D ):- 
+	D0 = cel( ProgVar, Sel0 ), 
+	proc_info_vartypes(ProcInfo, VarTypes), 
+	map__lookup( VarTypes, ProgVar, ProgVarType), 
+	pa_selector__apply_widening( ModuleInfo, ProgVarType, Sel0, Sel), 
+	D = cel( ProgVar, Sel ). 
+
+	
 
Index: pa_prelim_run.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/pa_prelim_run.m,v
retrieving revision 1.1.2.2
diff -u -r1.1.2.2 pa_prelim_run.m
--- pa_prelim_run.m	2000/10/03 08:53:41	1.1.2.2
+++ pa_prelim_run.m	2001/02/07 08:15:20
@@ -33,6 +33,7 @@
 :- import_module hlds_pred, liveness. 
 :- import_module hlds_goal, prog_data.
 
+
 annotate_all_liveness_in_module( HLDSin, HLDSout) :- 
 	module_info_predids( HLDSin, PRED_IDS0 ), 
 
Index: pa_run.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/pa_run.m,v
retrieving revision 1.1.2.11
diff -u -r1.1.2.11 pa_run.m
--- pa_run.m	2000/11/20 10:18:03	1.1.2.11
+++ pa_run.m	2001/02/07 08:15:20
@@ -47,12 +47,15 @@
 	%		the predicate is called
 	%		PredId, ProcId = id's of the called procedure
 	%		ActualArgs = args with which the proc is called
+	%		ActualTypes = types of the args with which the
+	% 			proc is called
 	%		AliasIN = alias at moment of call
 	%		AliasOUT = alias at end of call
 :- pred pa_run__extend_with_call_alias( module_info, proc_info, 
 			pred_id, proc_id, 
-			list(prog_var), alias_as, alias_as). 
-:- mode pa_run__extend_with_call_alias( in, in, in, in, in, in, out) is det.
+			list(prog_var), 
+			list( (type) ), alias_as, alias_as). 
+:- mode pa_run__extend_with_call_alias( in, in, in, in, in, in, in, out) is det.
 
 %-------------------------------------------------------------------%
 %-------------------------------------------------------------------%
@@ -71,6 +74,8 @@
 :- import_module liveness.
 
 
+% XXX lfu/lbu stuff
+:- import_module sr_lbu, sr_lfu.
 
 
 %-------------------------------------------------------------------%
@@ -199,8 +204,15 @@
 analyse_pred_proc( HLDS, PRED_PROC_ID , FPtable0, FPtable) -->
 	globals__io_lookup_bool_option(very_verbose,Verbose),
 
-	{ module_info_pred_proc_info( HLDS, PRED_PROC_ID,_PredInfo,ProcInfo) },
+	{ module_info_pred_proc_info( HLDS, PRED_PROC_ID,_PredInfo,
+			ProcInfo_tmp) },
 
+	% XXX annotate all lbu/lfu stuff
+	{ sr_lfu__process_proc(ProcInfo_tmp, ProcInfo_tmp2) }, 
+	{ sr_lbu__process_proc(HLDS, ProcInfo_tmp2, ProcInfo) }, 
+
+	% { ProcInfo = ProcInfo_tmp }, 
+
 	{ PRED_PROC_ID = proc(PredId, ProcId) },
 
 	{ pa_util__pa_fixpoint_table_which_run(FPtable0, Run) },
@@ -248,11 +260,30 @@
 		},
 		io__write_strings(["\t\t: ", FullS, "/", ProjectS, "/", 
 					NormS, "\n"])
+/**
+		io__write_strings(["\t\t: ", FullS, "/", ProjectS, "/", 
+					NormS, "\n"]),
+		(
+			{ dummy_test(PRED_PROC_ID) }
+		-> 
+			{ dummy_test_here( Alias ) }
+			io__write_string("Alias = "), 
+			pa_alias_as__print_aliases(Alias, ProcInfo),
+			io__write_string("\n\n")
+		;
+			[]
+		)
+**/
 
 	;
 		[]
 	).
 
+:- pred dummy_test( pred_proc_id::in) is semidet. 
+dummy_test( proc(PredId, _) ):- pred_id_to_int(PredId, 39). 
+:- pred dummy_test_here( alias_as::in ) is det.
+dummy_test_here(_). 
+
 	% analyse a given goal, with module_info and fixpoint table
 	% to lookup extra information, starting from an initial abstract
 	% substitution, and creating a new one. During this process,
@@ -267,19 +298,46 @@
 
 analyse_goal( ProcInfo, HLDS, 
 		Goal, FPtable0, FPtable, Alias0, Alias ) :- 
+
 	Goal = GoalExpr - GoalInfo ,
+	/* 
+	   extra: before even starting the analysis of the current goal, 
+	   first project the entering alias-set (Alias0) to the set 
+	   LFUi + LBUi + HeadVars
+        */
+	goal_info_get_lfu(GoalInfo, LFUi), 
+	goal_info_get_lbu(GoalInfo, LBUi), 
+	proc_info_real_headvars(ProcInfo, ListRealHeadVars), 
+	set__list_to_set(ListRealHeadVars, RealHeadVars), 
+	set__union(LFUi, LBUi, IN_USEi), 
+	set__union(IN_USEi, RealHeadVars, AliveVars), 
+	
 	analyse_goal_expr( GoalExpr, GoalInfo, 
 				ProcInfo, HLDS, 
 				FPtable0, FPtable, Alias0, Alias1),
-	% XXX Lets'  see what it all costs to remove them:
+
+	% projecting is too expensive to be done for each goal, 
+	% let's do it only on non-atomic goals: 
+
 	(
 		goal_is_atomic( GoalExpr )
 	->
 		Alias = Alias1	% projection operation is not worthwhile
 	; 
+		pa_alias_as__project_set( AliveVars, Alias1, Alias)
+	).
+
+/**
+	% XXX Lets'  see what it all costs to remove local vars:
+	(
+		goal_is_atomic( GoalExpr )
+	->
+		Alias = Alias1	% projection operation is not worthwhile
+	; 
 		goal_info_get_outscope( GoalInfo, Outscope), 
 		pa_alias_as__project_set( Outscope, Alias1, Alias)
 	).
+**/
 
 	
 :- pred analyse_goal_expr( hlds_goal_expr, 
@@ -298,7 +356,13 @@
 			ProcInfo, HLDS, T0, T, A0, A):- 
 	PRED_PROC_ID = proc(PredID, ProcID),
 	lookup_call_alias( PRED_PROC_ID, HLDS, T0, T, CallAlias), 
-	rename_call_alias( PRED_PROC_ID, HLDS, ARGS, CallAlias, RenamedCallAlias),
+	proc_info_vartypes( ProcInfo, VarTypes), 
+	list__map(
+		map__lookup( VarTypes ), 
+		ARGS, 
+		ActualTypes),
+	rename_call_alias( PRED_PROC_ID, HLDS, ARGS, ActualTypes, 
+				CallAlias, RenamedCallAlias),
 	pa_alias_as__extend( ProcInfo, HLDS, RenamedCallAlias, A0, A ).
 
 analyse_goal_expr( generic_call( GenCall,_,_,_), Info, 
@@ -444,10 +508,11 @@
 
 	% exported predicate
 extend_with_call_alias( HLDS, ProcInfo, 
-		PRED_ID, PROC_ID, ARGS, ALIASin, ALIASout ):-
+		PRED_ID, PROC_ID, ARGS, ActualTypes, ALIASin, ALIASout ):-
 	PRED_PROC_ID = proc(PRED_ID, PROC_ID), 
 	lookup_call_alias_in_module_info( HLDS, PRED_PROC_ID, ALIAS_tmp), 
-	rename_call_alias( PRED_PROC_ID, HLDS, ARGS, ALIAS_tmp, ALIAS_call),
+	rename_call_alias( PRED_PROC_ID, HLDS, ARGS, ActualTypes, 
+				ALIAS_tmp, ALIAS_call),
 	pa_alias_as__extend( ProcInfo, HLDS, ALIAS_call, ALIASin, ALIASout). 
 	
 :- pred lookup_call_alias_in_module_info( module_info, pred_proc_id, 
@@ -537,14 +602,17 @@
 	).
 
 :- pred rename_call_alias( pred_proc_id, module_info, list(prog_var),
+				list( (type) ), 
 				alias_as, alias_as).
-:- mode rename_call_alias( in, in, in, in, out) is det.
+:- mode rename_call_alias( in, in, in, in, in, out) is det.
 
-rename_call_alias( PRED_PROC_ID, HLDS, ARGS, Ain, Aout ):-
-	module_info_pred_proc_info( HLDS, PRED_PROC_ID, _P, ProcInfo),
+rename_call_alias( PRED_PROC_ID, HLDS, ARGS, ActualTypes, A0, A ):-
+	module_info_pred_proc_info( HLDS, PRED_PROC_ID, PredInfo, ProcInfo),
+	pred_info_arg_types(PredInfo, FormalTypes), 
 	proc_info_headvars(ProcInfo, Headvars),
 	map__from_corresponding_lists(Headvars,ARGS,Dict),
-	pa_alias_as__rename( Dict, Ain, Aout ).
+	pa_alias_as__rename( Dict, A0, A1 ),
+	pa_alias_as__rename_types( FormalTypes, ActualTypes, A1, A).
 
 %-------------------------------------------------------------------%
 %-------------------------------------------------------------------%
@@ -574,6 +642,8 @@
 :- import_module varset.
 :- import_module mercury_to_mercury.
 
+:- import_module pa_sr_util.
+
 	% inspiration taken from termination.m
 :- pred pa_run__make_pa_interface( module_info, io__state, io__state ).
 :- mode pa_run__make_pa_interface( in, di, uo ) is det.
@@ -683,21 +753,23 @@
 		% write headvars vars(HeadVar__1, ... HeadVar__n)
 	{ proc_info_varset(ProcInfo, ProgVarset) },
 	{ proc_info_real_headvars(ProcInfo, RealHeadVars) }, 
-	
-	( { RealHeadVars = [] } ->
-		io__write_string("vars")
-	;
-		io__write_string("vars("),
-		mercury_output_vars(RealHeadVars, ProgVarset, no),
-		io__write_string(")")
-	),
+	{ proc_info_vartypes( ProcInfo, VarTypes) }, 
+	{ pred_info_typevarset( PredInfo, TypeVarSet ) },
+
+	pa_sr_util__trans_opt_output_vars_and_types(
+			ProgVarset, 
+			VarTypes, 
+			TypeVarSet, 
+			RealHeadVars ),
+
 	io__write_string(", "),
 
 		% write alias information
 
 	{ proc_info_possible_aliases(ProcInfo, MaybeAliases) },
 
-	pa_alias_as__print_maybe_interface_aliases( MaybeAliases, ProcInfo),
+	pa_alias_as__print_maybe_interface_aliases( MaybeAliases, 
+					ProcInfo, PredInfo),
 
 	io__write_string(").\n").
 
Index: pa_selector.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/pa_selector.m,v
retrieving revision 1.1.2.1
diff -u -r1.1.2.1 pa_selector.m
--- pa_selector.m	2000/09/19 10:02:08	1.1.2.1
+++ pa_selector.m	2001/02/07 08:15:21
@@ -33,7 +33,10 @@
 %-- exported types
 
 :- type selector == list(unit_sel).
-:- type unit_sel ---> us( hlds_data__cons_id, int ).
+:- type unit_sel ---> 
+		us( hlds_data__cons_id, int ) ;  % normal selector
+		ts( prog_data__type ).		 % type selector
+			
 
 %-------------------------------------------------------------------%
 %-------------------------------------------------------------------%
@@ -71,9 +74,20 @@
 :- pred less_or_equal(selector, selector, selector).
 :- mode less_or_equal(in, in, out) is semidet.
 
-:- pred print( selector, io__state, io__state).
-:- mode print( in, di, uo) is det.
+	% less_or_equal( HLDS, S1, S2, T, EXT):
+	% Find out whether selector S1 of a variable of type T is
+	% less or equal to another selector S2 belonging to the same
+	% variable of type T. If so, return the extension such that
+	% S1 == S2.EXT
+:- pred less_or_equal( module_info::in, selector::in, selector::in, 
+		(type)::in, selector::out) is semidet.
 
+:- pred rename_types( term__substitution(tvar_type)::in, 
+		selector::in, selector::out) is det.
+
+:- pred print( selector::in, tvarset::in, 
+		io__state::di, io__state::uo) is det. 
+
 :- pred parse_term( term(T), selector).
 :- mode parse_term( in, out ) is det.
 
@@ -81,13 +95,17 @@
 :- pred normalize_wti( (type), module_info, selector, selector).
 :- mode normalize_wti( in, in, in, out) is det.
 
+	% widening
+:- pred apply_widening( module_info::in, (type)::in,
+		selector::in, selector::out) is det.
+
 %-------------------------------------------------------------------%
 %-------------------------------------------------------------------%
 
 :- implementation.
 
 % library modules
-:- import_module require, string, std_util.
+:- import_module require, string, std_util, bool.
 
 % compiler modules
 :- import_module mercury_to_mercury, prog_io, type_util.
@@ -116,25 +134,47 @@
 
 less_or_equal( S1, S2, EXT ) :- 
 	list__append(S2, EXT , S1). 
+
+
+rename_types( Subst, Sel0, Sel ):- 
+	list__map( unit_selector_rename_types( Subst ), Sel0, Sel ).
 
-print( SELECTOR ) -->
+:- pred unit_selector_rename_types( term__substitution(tvar_type)::in,
+		unit_sel::in, unit_sel::out ) is det.
+
+unit_selector_rename_types( Subst, US0, US ) :- 
+	(
+		US0 = us(_,_),
+		US = US0
+	;
+		US0 = ts( Type0 ), 
+		term__apply_substitution( Type0, Subst, Type ), 
+		US = ts( Type )
+	).
+	
+print( Selector, ProgVarSet ) -->
 	io__write_string("["),
-	io__write_list(SELECTOR, ",", print_unit_selector),
+	io__write_list(Selector, ",", print_unit_selector(ProgVarSet) ),
 	io__write_string("]").
 
-:- pred print_unit_selector( unit_sel, io__state, io__state).
-:- mode print_unit_selector( in, di, uo) is det.
+:- pred print_unit_selector( tvarset, unit_sel, io__state, io__state).
+:- mode print_unit_selector( in, in, di, uo) is det.
 
-print_unit_selector( us( CONS, INDEX ) ) -->
-	{ hlds_data__cons_id_arity( CONS, ARITY ) },
+print_unit_selector( _ProgVarSet, us( Cons, Index ) ) -->
+	{ hlds_data__cons_id_arity( Cons, Arity ) },
 	io__write_string( "sel("),
-	mercury_output_cons_id(CONS, needs_brackets),
+	mercury_output_cons_id(Cons, needs_brackets),
 	io__write_string( "," ),
-	io__write_int( ARITY ),
+	io__write_int( Arity ),
 	io__write_string(","),
-	io__write_int(INDEX),
+	io__write_int(Index),
 	io__write_string(")").
+print_unit_selector( ProgVarSet, ts( Type )) --> 
+	io__write_string( "typesel("), 
+	mercury_output_term( Type, ProgVarSet, bool__no), 
+	io__write_string( ")").
 
+
 parse_term( TERM, SEL ):- 
 	(
 		TERM = term__functor( term__atom(CONS), Args, _)
@@ -191,7 +231,14 @@
 	    error("(pa_selector) parse_unit_selector: unknown cons_id in unit selector")
 	 )
       ; 
-         error("(pa_selector) parse_unit_selector: top constructor should be sel/3")
+	 
+         CONS = "typesel",
+	 Args = [ TypeSelectorTerm ]
+      ->
+ 	 term__coerce( TypeSelectorTerm, TypeSelector ), 
+	 US = ts( TypeSelector )
+      ;
+	 error("(pa_selector) parse_unit_selector: top constructor should be sel/3 or typesel/1.")
       )
    ;
       error("(pa_selector) parse_unit_selector: term not a functor")
@@ -215,7 +262,8 @@
 		SEL = Acc0
 	;
 		select_first_part( SEL0, US, SELR ),
-		US = us(CONS, INDEX), 
+		US = us(CONS, INDEX)
+	->
 		type_util__classify_type( VarType, HLDS, Class ),
 		(
 			Class = user_type
@@ -275,6 +323,9 @@
 			append(Acc0,SEL0,SEL)
 
 		)
+	;
+		
+		SEL = SEL0	
 	).
 
 :- pred get_type_id((type),type_id).
@@ -348,4 +399,188 @@
 	;
 	        branch_map_search(Ms, T2, S)
 	).
+
+
+%-------------------------------------------------------------------%
+%-------------------------------------------------------------------%
+% additional predicates
+%-------------------------------------------------------------------%
+
+	% split_upto_type_selector( Sin, S1, TS, S2 ): 
+	%	this predicate succeeds if there exists a typeselector
+	% 	TS, such that Sin is equivalent to append(S1, [TS | S2] )
+	% 	and S1 contains no other type selector. It fails otherwise. 
+:- pred split_upto_type_selector(selector::in, selector::out, 
+		unit_sel::out,
+		selector::out) is semidet.
+
+split_upto_type_selector( Sin, S1, TS, S2 ):-
+	split_upto_type_selector_acc( Sin, [], S1, TS, S2). 
+
+:- pred split_upto_type_selector_acc( selector::in, selector::in, 
+		selector::out, unit_sel::out, selector::out) is semidet.
+split_upto_type_selector_acc( [ US | SEL ], ACC, S1, TS, S2 ):-
+	(
+		US = ts(_)
+	->
+		S1 = ACC, 
+		TS = US, 
+		S2 = SEL
+	; 
+		append(ACC, [US], ACC2),
+		split_upto_type_selector_acc( SEL, ACC2, S1, TS, S2 )
+	). 
+
+
+less_or_equal( HLDS, S1, S2, MainType, EXT ):- 
+	(
+		split_upto_type_selector(S2, S2_part1, TS, S2_part2 ),
+		TS = ts( SubType )
+	->
+		(
+
+			less_or_equal( HLDS, S1, S2_part1, MainType, Rest)
+			% append(S2_part1, Rest, S1) % walk past S2_part1
+						% S1 = S2_part1.Rest
+		->
+			% and now the type-testing part... 
+			% can be formulated as: starting from S2_part1,
+			% does the remainder of the path Rest lead through
+			get_type_of_node( HLDS, MainType, S2_part1, NodeType), 
+				% from NodeType, to TS
+			type_on_path( HLDS, NodeType, SubType, Rest, Remainder),
+			less_or_equal( HLDS, Remainder, S2_part2, SubType, EXT)
+		;
+			fail	% the walks do not correspond
+		)
+	; 
+		(
+			split_upto_type_selector(S1, _S1_part1, _TS1, 
+				_S2_part2 )
+		->
+			fail
+		; 
+			% normal case without type-selectors
+			less_or_equal(S1, S2, EXT )
+		)
+	). 
+
+apply_widening( ModuleInfo, MainType, Selector0, Selector ) :-
+	(
+		Selector0 = []
+	-> 
+		Selector = Selector0
+	; 
+		get_type_of_node( ModuleInfo, MainType, Selector0, SubType), 
+		Selector = [ ts( SubType ) ]
+	).
+
+
+	% get_type_of_node( ModuleInfo, StartType, Selector, SubType)
+	% determines the type SybType of the node obtained by traversing
+	% the StartType using the path Selector. 
+:- pred get_type_of_node( module_info::in, (type)::in, selector::in, 
+		(type)::out) is det.
+get_type_of_node( ModuleInfo, StartType, Selector, SubType ):-
+	(
+		Selector = [ US | RestSelector ]
+	->
+		(
+			US = us( CONS_ID, CHOICE ),
+			select_subtype( ModuleInfo, StartType, CONS_ID, 
+				CHOICE, SubType0 ) 
+		; 
+			US = ts( SubType0 )
+		),
+		get_type_of_node( ModuleInfo, SubType0, 
+				RestSelector, SubType )	
+	;
+		SubType = StartType
+	).
+
+	% select_subtype( ModuleInfo, Type, ConsID, Position, SubType):
+	% select the subtype of a type Type, selecting ConsId's position
+	% Position. Position counts starting from 1 (and not 0). 
+	% Predicate aborts if subtype cannot be determined. 
+:- pred select_subtype( module_info::in, (type)::in, 
+		cons_id::in, int::in, (type)::out) is det.
+select_subtype( ModuleInfo, Type, ConsID, Choice, SubType) :-
+	(
+		type_util__get_cons_id_non_existential_arg_types(ModuleInfo, 
+			Type, ConsID, ArgTypes)
+	->
+		(
+			list__index1(ArgTypes, Choice, SubType0)
+		->
+			SubType = SubType0
+		;
+			require__error("(pa_selector) get_type_of_node: selection of subtype failed.")
+		)
+	;
+		require__error("(pa_selector) get_type_of_node: existential type encountered.")
+	).
+
+
+	% type_on_path(ModuleInfo, FromType, ToType, Path, Remainder):
+	% this predicate verifies that the path Path starting from 
+	% FromType passes the type ToType. Remainder is the remainder
+	% of the selector. 
+	% The Path may contain type-selectors. 
+	% XXX this predicate should be nondet as Path might lead through
+	% different nodes of type ToType, each yielding a different
+	% Remainder. 
+:- pred type_on_path( module_info::in, (type)::in, (type)::in, 
+		selector::in, selector::out) is semidet.
+
+type_on_path( ModuleInfo, FromType, ToType, Path, RemainderPath) :-
+	% require at least one step!
+	% notation of any non-zero selector which selects a node of
+	% the type described in the type-selector. 
+	type_on_path_2( first, ModuleInfo, FromType, 
+			ToType, Path, RemainderPath).
+
+:- type step ---> first ; subsequent. 
+:- pred type_on_path_2( step::in, module_info::in, (type)::in, (type)::in, 
+		selector::in, selector::out) is semidet.
+
+type_on_path_2( Step, ModuleInfo, FromType, ToType, Path, RemainderPath) :- 
+	(
+		FromType = ToType, 
+		Step = subsequent	
+	->
+		RemainderPath = Path
+	; 
+		Path = [ US | Rest ],
+		(
+			US = ts( SubType ),
+			(
+				SubType = ToType
+			->
+				RemainderPath = Rest
+			;
+				type_on_path_2( subsequent, ModuleInfo, 
+						SubType, ToType, 
+						Rest, RemainderPath)
+			)
+		;
+			US = us( CONS_ID, CHOICE ), 
+			select_subtype( ModuleInfo, FromType, CONS_ID, 
+				CHOICE, SubType ),
+			(
+				SubType = ToType
+			->
+				RemainderPath = Rest
+			;
+				type_on_path_2( subsequent, 
+					ModuleInfo, SubType, ToType, 
+					Rest, RemainderPath)
+			)
+		)
+	).
+
+
+
+	
 
Index: pa_sr_util.m
===================================================================
RCS file: pa_sr_util.m
diff -N pa_sr_util.m
--- /dev/null	Wed Nov 15 09:24:47 2000
+++ pa_sr_util.m	Wed Feb  7 19:15:21 2001
@@ -0,0 +1,77 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 1996-2000 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+
+% module pa_sr_util: extra utility predicates common to the alias (pa_*) and
+%		     reuse passes (sr_*)
+% main author: nancy
+
+:- module pa_sr_util.
+
+:- interface. 
+%-----------------------------------------------------------------------------%
+
+:- import_module io, list, std_util, term. 
+:- import_module hlds_pred, prog_data. 
+
+:- pred trans_opt_output_vars_and_types( 
+		prog_varset::in, 
+		vartypes::in, 
+		tvarset::in, 
+		list(prog_var)::in, 
+		io__state::di, 
+		io__state::uo) is det.
+
+:- pred rename_type_det( pair( (type), (type) )::in,
+                term__substitution(tvar_type)::in,
+                term__substitution(tvar_type)::out ) is det.
+
+
+%-----------------------------------------------------------------------------%
+:- implementation. 
+
+:- import_module bool, map, require.
+:- import_module mercury_to_mercury.
+
+
+trans_opt_output_vars_and_types( ProgVarSet, VarTypes, TypeVarSet, 
+			RealHeadVars ) --> 
+	( 
+		{ RealHeadVars = [] } 
+	->
+		io__write_string("vars, types")
+
+	;
+		io__write_string("vars("),
+		mercury_output_vars(RealHeadVars, ProgVarSet, no),
+		io__write_string("), "),
+
+		% extra info: 
+		io__write_string("types("),
+		io__write_list(RealHeadVars, ",",
+			output_type_of_var(VarTypes, TypeVarSet) ),
+		io__write_string(")")
+	).
+
+:- pred output_type_of_var( vartypes::in, tvarset::in, prog_var::in,
+                io__state::di, io__state::uo) is det.
+
+output_type_of_var( VarTypes, TypeVarSet, SomeVar ) -->
+        { map__lookup( VarTypes, SomeVar, Type ) },
+        mercury_output_term(Type, TypeVarSet, bool__no).
+
+
+rename_type_det( FromType - ToType, S0, S ) :-
+        (
+                term__unify( FromType, ToType, S0, S1 )
+        ->
+                S = S1
+        ;
+                require__error("(pa_alias_as) rename_type_det: types are not
+unifiable.")
+        ).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
Index: prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.58.2.5
diff -u -r1.58.2.5 prog_data.m
--- prog_data.m	2000/11/13 18:37:10	1.58.2.5
+++ prog_data.m	2001/02/07 08:15:21
@@ -262,7 +262,8 @@
 			% trans_opt files.
 
 	;	pa_alias_info(pred_or_func, sym_name, list(mode),
-				list(prog_var), maybe(alias_as))
+				list(prog_var), list( (type) ), 
+				maybe(alias_as))
 			% the list(mode) is the declared argmodes of the
 			% procedure. 
 			% This pragma is used to define information about
@@ -270,7 +271,8 @@
 			% These pragma's are used in opt.pa files
 
 	; 	sr_reuse_info(pred_or_func, sym_name, list(mode), 
-				list(prog_var), memo_reuse, maybe(sym_name))
+				list(prog_var), 
+				list( (type) ), memo_reuse, maybe(sym_name))
 
 	;	terminates(sym_name, arity)
 			% Predname, Arity
Index: prog_io_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.23.2.4
diff -u -r1.23.2.4 prog_io_pragma.m
--- prog_io_pragma.m	2000/11/13 18:37:16	1.23.2.4
+++ prog_io_pragma.m	2001/02/07 08:15:22
@@ -751,6 +751,7 @@
 	PragmaTerms = [ 
 		PredAndModesTerm0,
 		HVsTerm,
+		HVsTypes,
 		AliasInformation
 	],
 	parse_pred_or_func_and_arg_modes(yes(ModuleName), PredAndModesTerm0,
@@ -763,8 +764,11 @@
 	term__vars_list(ListHVTerm, HeadVarsGeneric),
 	list__map(term__coerce_var, HeadVarsGeneric, HeadVars),
 
-	% aliases
+	% types
+	HVsTypes = term__functor(term__atom("types"), ListHVTypesTerm, _),
+	list__map(term__coerce, ListHVTypesTerm, HVTypes ), 
 
+	% aliases
 	(
 	   	AliasInformation = term__functor(
 					term__atom("not_available"),_,_),
@@ -777,7 +781,7 @@
 	),
 
 	Result0 = ok(pragma(pa_alias_info(PredOrFunc, PredName, ModeList,
-					HeadVars, MaybeAliasInfo)))
+					HeadVars, HVTypes, MaybeAliasInfo)))
    ->
    	Result = Result0
    ;
@@ -792,6 +796,7 @@
 	PragmaTerms = [ 
 		PredAndModesTerm0,
 		HVsTerm,
+		HVsTypes, 
 		ReuseInformation
 	],
 	parse_pred_or_func_and_arg_modes(yes(ModuleName), PredAndModesTerm0,
@@ -804,11 +809,15 @@
 	term__vars_list(ListHVTerm, HeadVarsGeneric),
 	list__map(term__coerce_var, HeadVarsGeneric, HeadVars),
 
+	% types
+	HVsTypes = term__functor(term__atom("types"), ListHVTypesTerm, _),
+	list__map(term__coerce, ListHVTypesTerm, HVTypes ), 
+
 	sr_data__memo_reuse_parse(ReuseInformation, ParsedReuse,
 			MaybeReuseName),
 
 	Result0 = ok(pragma(sr_reuse_info(PredOrFunc, PredName, ModeList,
-					HeadVars, ParsedReuse,
+					HeadVars, HVTypes, ParsedReuse,
 					MaybeReuseName)))
    ->
    	Result = Result0
Index: sr_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/sr_data.m,v
retrieving revision 1.1.2.11
diff -u -r1.1.2.11 sr_data.m
--- sr_data.m	2000/10/23 07:31:35	1.1.2.11
+++ sr_data.m	2001/02/07 08:15:23
@@ -81,9 +81,10 @@
 :- mode reuse_condition_equal(in, in) is semidet.
 
 	% condition_init(Var, LFUi, LBUi, ALIASi, HVs, Condition).
-:- pred reuse_condition_init(prog_var, set(prog_var), set(prog_var), 
-		alias_as, list(prog_var), reuse_condition).
-:- mode reuse_condition_init(in, in, in, in, in, out) is det.
+:- pred reuse_condition_init(module_info, proc_info,
+			prog_var, set(prog_var), set(prog_var), 
+			alias_as, list(prog_var), reuse_condition).
+:- mode reuse_condition_init(in, in, in, in, in, in, in, out) is det.
 
 	% rename the reuse condition given a map from FROM_VARS, to
 	% TO_VARS
@@ -91,10 +92,13 @@
 		reuse_condition, reuse_condition).
 :- mode reuse_condition_rename( in, in, out ) is det.
 
+:- pred reuse_condition_rename_types( term__substitution(tvar_type)::in, 
+		reuse_condition::in, reuse_condition::out) is det.
+
 	% print the reuse_condition 
-:- pred reuse_condition_print( proc_info, reuse_condition, io__state, 
-				io__state).
-:- mode reuse_condition_print( in, in, di, uo) is det.
+:- pred reuse_condition_print( proc_info, pred_info, reuse_condition, 
+				io__state, io__state).
+:- mode reuse_condition_print( in, in, in, di, uo) is det.
 
 	% check whether the given live_set and alias_as satisfy
 	% the condition for reuse. 
@@ -121,8 +125,13 @@
 		memo_reuse::in, memo_reuse::out) is det.
 :- pred memo_reuse_rename( map(prog_var, prog_var)::in, memo_reuse::in,
 		memo_reuse::out) is det.
+	% memo_reuse_rename_types( FromTypes, ToTypes, Memo0, Memo).
+	% Rename all the types occurring in the memo_reuse from FromTypes, 
+	% to ToTypes.
+:- pred memo_reuse_rename_types( list((type))::in, list((type))::in, 
+		memo_reuse::in, memo_reuse::out) is det.
 :- pred memo_reuse_print( memo_reuse::in, sym_name::in, proc_info::in,
-		io__state::di, io__state::uo) is det.
+		pred_info::in, io__state::di, io__state::uo) is det.
 :- pred memo_reuse_parse( term(T)::in, memo_reuse::out, 
 		maybe(sym_name)::out) is semidet.
 :- pred memo_reuse_verify_reuse( proc_info::in, module_info::in, 
@@ -138,10 +147,10 @@
 
 :- implementation.
 
-:- import_module list, string, require, varset, bool.
+:- import_module list, string, require, varset, bool, assoc_list.
 :- import_module pa_datastruct, pa_alias_as.
 :- import_module mercury_to_mercury, prog_out, prog_io, prog_io_util.
-:- import_module sr_util.
+:- import_module sr_util, pa_sr_util.
 
 reuse_condition_merge( C1, C2, C ):-
 	(
@@ -184,7 +193,8 @@
 	set__equal(LU1, LU2),
 	pa_alias_as__equal(LA1, LA2).
 
-reuse_condition_init(Var, LFUi, LBUi, ALIASi, HVs, CONDITION):- 
+reuse_condition_init(ModuleInfo, ProcInfo, 
+				Var, LFUi, LBUi, ALIASi, HVs, CONDITION):- 
 	% First determine the nodes to which the reuse is related. 
 	% There are two cased:
 	% 1. Var is a headvar, then it is sufficient to keep the topcel
@@ -202,7 +212,8 @@
 	->
 		NODES = [TopCel]
 	;
-		pa_alias_as__collect_aliases_of_datastruct(TopCel, 
+		pa_alias_as__collect_aliases_of_datastruct(ModuleInfo, 
+			ProcInfo, TopCel, 
 			ALIASi, AliasedData),
 		list__filter(
 			pred(DATA::in) is semidet :-
@@ -248,17 +259,39 @@
 	;
 		Cout = Cin
 	).
+
+reuse_condition_rename_types( Subst, Cond0, Cond ):-
+	(
+		Cond0 = condition( Nodes0, LUiH0, LAiH0 ),
+		% rename the selectors of the nodes
+		set__to_sorted_list( Nodes0, NodesList0 ), 
+		list__map(
+			pa_datastruct__rename_types( Subst ), 
+			NodesList0, 
+			NodesList ), 
+		set__list_to_set( NodesList, Nodes), 
+		% LUiH needs no renaming:
+		LUiH = LUiH0, 
+		% rename the selector of the local aliases
+		pa_alias_as__rename_types( Subst, LAiH0, LAiH ), 
+		% combine the whole stuff
+		Cond = condition( Nodes, LUiH, LAiH )
+	;
+		Cond0 = always, 
+		Cond = always
+	).
 
-reuse_condition_print( _, always ) -->
+reuse_condition_print( _, _, always ) -->
 	io__write_string("always").
-reuse_condition_print( ProcInfo, condition(Nodes, LUiH, LAiH)) -->
+reuse_condition_print( ProcInfo, PredInfo, condition(Nodes, LUiH, LAiH)) -->
 	{ set__to_sorted_list( Nodes, NodesList ) }, 
 	io__write_string("condition("),
 		% write out the list of headvar-nodes involved
 	io__write_string("["),
 	io__write_list( NodesList, ",", 
 			pred( D::in, IO1::di, IO2::uo) is det :- 
-			    ( pa_datastruct__print(D, ProcInfo, IO1, IO2) )
+			    ( pa_datastruct__print(D, ProcInfo, 
+						PredInfo, IO1, IO2) )
 			),
 	io__write_string("], "),	
 
@@ -270,7 +303,7 @@
 	io__write_string("], "),
 
 		% write out LAiH, the aliases at the reuse-point
-	pa_alias_as__print_aliases(LAiH, ProcInfo),	
+	pa_alias_as__print_aliases(LAiH, ProcInfo, PredInfo),	
 
 	io__write_string(")").
 
@@ -287,11 +320,11 @@
 		), set__to_sorted_list(Nodes), []),
 	
 	pa_alias_as__extend( ProcInfo, HLDS, Alias0, LAiH, Alias),
-	pa_alias_as__live( LUiH, Live0, Alias, Live), 
+	pa_alias_as__live( HLDS, ProcInfo, LUiH, Live0, Alias, Live), 
 	set__to_sorted_list(Nodes, NodesList), 
 	list__filter(
 		pred( D::in ) is semidet :- 
-		    ( sr_live__is_live_datastruct(D, Live) ),
+		    ( sr_live__is_live_datastruct(HLDS, ProcInfo, D, Live) ),
 		NodesList,
 		[] ).
 
@@ -305,7 +338,8 @@
 	set__to_sorted_list( OLD_NODES_set, OLD_NODES ), 
 	list__map(
 		pred(TOP::in,LIST::out) is det :- 
-			( pa_alias_as__collect_aliases_of_datastruct(TOP, 
+			( pa_alias_as__collect_aliases_of_datastruct(HLDS,
+				ProcInfo, TOP, 
 				ALIASi, LIST)),
 		OLD_NODES,
 		LISTS_ALL_NEW_NODES
@@ -417,13 +451,36 @@
 	;
 		TREUSEout = TREUSEin
 	).
+
+memo_reuse_rename_types( FromTypes, ToTypes, Memo0, Memo) :-
+	assoc_list__from_corresponding_lists( FromTypes, ToTypes, 
+				FromToTypes), 
+	list__foldl( pa_sr_util__rename_type_det, FromToTypes, 
+			map__init, Substitution ), 
+	memo_reuse_rename_types_2( Substitution, Memo0, Memo ). 
+
+:- pred memo_reuse_rename_types_2( term__substitution(tvar_type)::in, 
+		memo_reuse::in, memo_reuse::out) is det.
+memo_reuse_rename_types_2( Subst, Memo0, Memo) :- 
+	(
+		Memo0 = yes(Conditions0),
+		list__map(
+			reuse_condition_rename_types( Subst ), 
+			Conditions0, 
+			Conditions), 
+		Memo = yes(Conditions)
+	;
+		Memo0 = no, 
+		Memo = no
+	).
 
-memo_reuse_print( TREUSE, Name, ProcInfo ) --> 
+memo_reuse_print( TREUSE, Name, ProcInfo, PredInfo ) --> 
 	( 	
 		{ TREUSE = yes(CONDS) }
 	->
 		io__write_string("yes(["),
-		io__write_list(CONDS, ",", reuse_condition_print(ProcInfo)),
+		io__write_list(CONDS, ",", 
+			reuse_condition_print(ProcInfo, PredInfo)),
 		io__write_string("], "),
 		prog_out__write_quoted_sym_name(Name),
 		io__write_string(")")
Index: sr_dead.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/sr_dead.m,v
retrieving revision 1.1.2.8
diff -u -r1.1.2.8 sr_dead.m
--- sr_dead.m	2000/10/23 07:31:36	1.1.2.8
+++ sr_dead.m	2001/02/07 08:15:24
@@ -66,8 +66,13 @@
 annotate_goal( ProcInfo, HLDS, Expr0 - Info0, Goal, 
 			Pool0, Pool, Alias0, Alias) :- 
 	Expr0 = call(PredId, ProcId, ActualVars, _, _, _),
+	proc_info_vartypes( ProcInfo, VarTypes ), 
+	list__map( 
+		map__lookup( VarTypes ), 
+		ActualVars, 
+		ActualTypes ), 
 	pa_run__extend_with_call_alias( HLDS, ProcInfo, 
-		PredId, ProcId, ActualVars, Alias0, Alias),
+		PredId, ProcId, ActualVars, ActualTypes, Alias0, Alias),
 	Expr = Expr0, 
 	Info = Info0, 
 	Pool = Pool0, 
@@ -99,7 +104,7 @@
 annotate_goal( ProcInfo, HLDS, Expr0 - Info0, Goal, 
 			Pool0, Pool, Alias0, Alias) :- 
 	Expr0 = unify(_Var, _Rhs, _Mode, Unification0, _Context),
-	unification_verify_reuse(Unification0, Alias0, 
+	unification_verify_reuse(HLDS, ProcInfo, Unification0, Alias0, 
 		Pool0, Pool, Info0, Info),
 		% XXX candidate for future optimization: if
 		% you annotate the deconstruct first, you might avoid
@@ -212,12 +217,14 @@
 			Alias0, Alias), 
 	Case = case(CONS, Goal).
 
-:- pred unification_verify_reuse( hlds_goal__unification, 
+:- pred unification_verify_reuse( module_info, proc_info, 
+		hlds_goal__unification, 
 		alias_as, dead_cell_pool, dead_cell_pool, 
 		hlds_goal_info, hlds_goal_info).
-:- mode unification_verify_reuse( in, in, in, out, in, out) is det.
+:- mode unification_verify_reuse( in, in, in, in, in, out, in, out) is det.
 
-unification_verify_reuse( Unification, Alias0, Pool0, Pool,
+unification_verify_reuse( ModuleInfo, ProcInfo, 
+				Unification, Alias0, Pool0, Pool,
 				Info0, Info) :- 
 	(
 		Unification = deconstruct( Var, CONS_ID, _, _, _, _)
@@ -226,7 +233,8 @@
 		goal_info_get_lbu( Info0, LBU ),
 		set__union( LFU, LBU, LU), 
 		sr_live__init(LIVE0),
-		pa_alias_as__live(LU, LIVE0, Alias0, LIVE), 
+		pa_alias_as__live(ModuleInfo, ProcInfo, LU, LIVE0, 
+				Alias0, LIVE), 
 		(
 			( 
 				sr_live__is_live(Var,LIVE) 
@@ -239,7 +247,8 @@
 				choice(deconstruct(no)), Info),
 			Pool = Pool0
 		;
-			add_dead_cell( Var, CONS_ID, 
+			add_dead_cell( ModuleInfo, ProcInfo, 
+					Var, CONS_ID, 
 					LFU, LBU,
 					Alias0, Pool0, Pool, 
 					ReuseCondition),
@@ -292,16 +301,16 @@
 	% test if empty
 :- pred dead_cell_pool_is_empty(dead_cell_pool::in) is semidet.
 
-:- pred add_dead_cell(prog_var, cons_id, set(prog_var), 
+:- pred add_dead_cell(module_info, proc_info, prog_var, cons_id, set(prog_var), 
 			set(prog_var), alias_as, 
 			dead_cell_pool, dead_cell_pool, 
 			reuse_condition).
-:- mode add_dead_cell(in, in, in, in, in, in, out, out) is det.
+:- mode add_dead_cell(in, in, in, in, in, in, in, in, out, out) is det.
 
 	% given its reuse_condition, add the dead cell to dr_info.
-:- pred add_dead_cell(prog_var, cons_id, reuse_condition, 
+:- pred add_dead_cell( prog_var, cons_id, reuse_condition, 
 			dead_cell_pool, dead_cell_pool) is det.
-:- mode add_dead_cell(in, in, in, in, out) is det.
+:- mode add_dead_cell( in, in, in, in, out) is det.
 
 :- pred dead_cell_pool_least_upper_bound_disj( set(prog_var),
 				list(dead_cell_pool), dead_cell_pool).
@@ -330,9 +339,11 @@
 dead_cell_pool_is_empty( pool(_, Pool) ):- 
 	map__is_empty(Pool).
 
-add_dead_cell(Var, Cons, LFU, LBU, Alias0, Pool0, Pool, Condition) :- 
+add_dead_cell(ModuleInfo, ProcInfo, Var, Cons, LFU, LBU, 
+			Alias0, Pool0, Pool, Condition) :- 
 	Pool0 = pool(HVS, _Map0), 
-	reuse_condition_init(Var, LFU, LBU, Alias0, HVS, Condition),
+	reuse_condition_init(ModuleInfo, ProcInfo, Var, LFU, LBU, 
+			Alias0, HVS, Condition),
 	add_dead_cell( Var, Cons, Condition, Pool0, Pool).
 
 
Index: sr_indirect.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/sr_indirect.m,v
retrieving revision 1.1.2.14
diff -u -r1.1.2.14 sr_indirect.m
--- sr_indirect.m	2000/10/27 11:22:17	1.1.2.14
+++ sr_indirect.m	2001/02/07 08:15:24
@@ -1,4 +1,5 @@
-%-----------------------------------------------------------------------------%
+
+				%-----------------------------------------------------------------------------%
 % Copyright (C) 2000 The University of Melbourne.
 % This file may only be copied under the terms of the GNU General
 % Public License - see the file COPYING in the Mercury distribution.
@@ -273,10 +274,16 @@
 
 analyse_goal( ProcInfo, HLDS, Expr0 - Info0, Goal, AI0, AI) :-
 	Expr0 = call(PredId, ProcId, ActualVars, _, _, _), 
+	proc_info_vartypes( ProcInfo, VarTypes),
+	list__map( 
+		map__lookup( VarTypes ), 
+		ActualVars,
+		ActualTypes), 
 	call_verify_reuse( ProcInfo, HLDS,
-			PredId, ProcId, ActualVars, Info0, Info, AI0, AI1, _),
+			PredId, ProcId, ActualVars, 
+			ActualTypes, Info0, Info, AI0, AI1, _),
 	pa_run__extend_with_call_alias( HLDS, ProcInfo, 
-		PredId, ProcId, ActualVars, AI0 ^ alias, Alias),
+		PredId, ProcId, ActualVars, ActualTypes, AI0 ^ alias, Alias),
 	AI = AI1 ^ alias := Alias,
 	Expr = Expr0, 
 	Goal = Expr - Info.
@@ -473,13 +480,19 @@
 analyse_goal( ProcInfo, HLDS, Expr0 - Info0, Goal, Pool0, Pool, Alias0, Alias, 
 			FP0, FP) :- 
 	Expr0 = call(PredId, ProcId, ActualVars, _, _, _), 
+	proc_info_vartypes( ProcInfo, VarTypes),
+	list__map( 
+		map__lookup(VarTypes),
+		ActualVars, 
+		ActualTypes),
 	call_verify_reuse( ProcInfo, HLDS,
-		PredId, ProcId, ActualVars, Alias0, set__init,
+		PredId, ProcId, ActualVars, ActualTypes, 
+		Alias0, set__init,
 		Pool0, Pool,
 		Info0, Info, 
 		FP0, FP, _),
 	pa_run__extend_with_call_alias( HLDS, ProcInfo, 
-		PredId, ProcId, ActualVars, Alias0, Alias),
+		PredId, ProcId, ActualVars, ActualTypes, Alias0, Alias),
 	Expr = Expr0, 
 	Goal = Expr - Info.
 
@@ -668,27 +681,31 @@
 
 :- pred call_verify_reuse( proc_info::in, module_info::in,
 		pred_id::in, proc_id::in, list(prog_var)::in,
+		list( (type) )::in, 
 		hlds_goal_info::in, hlds_goal_info::out, 
 		analysis_info::in, analysis_info::out, bool::out) is det.
 
 call_verify_reuse(ProcInfo, ModuleInfo, PredId, ProcId, ActualVars,
+		ActualTypes, 
 		GoalInfo0, GoalInfo, analysis_info(Alias0, Pool0, Static, FP0),
 		analysis_info(Alias0, Pool, Static, FP), YesNo) :-
 	call_verify_reuse(ProcInfo, ModuleInfo, PredId, ProcId, ActualVars,
+			ActualTypes, 
 			Alias0, Static, Pool0, Pool, GoalInfo0, GoalInfo,
 			FP0, FP, YesNo).
 
 :- pred call_verify_reuse( proc_info::in, module_info::in, pred_id::in,
-		proc_id::in, list(prog_var)::in, alias_as::in,
+		proc_id::in, list(prog_var)::in, list( (type) )::in, 
+		alias_as::in,
 		set(prog_var)::in, indirect_reuse_pool::in,
 		indirect_reuse_pool::out, hlds_goal_info::in ,
 		hlds_goal_info::out, sr_fixpoint_table__table::in,
 		sr_fixpoint_table__table::out, bool::out) is det.
 
-call_verify_reuse( ProcInfo, HLDS, PredId0, ProcId0, ActualVars, Alias0, 
-					StaticTerms,
-					Pool0, Pool, 
-					Info0, Info, FP0, FP, YesNo ) :- 
+call_verify_reuse( ProcInfo, HLDS, PredId0, ProcId0, 
+			ActualVars, ActualTypes, Alias0, 
+			StaticTerms, Pool0, Pool, 
+			Info0, Info, FP0, FP, YesNo ) :- 
 
 	module_info_structure_reuse_info(HLDS, ReuseInfo),
 	ReuseInfo = structure_reuse_info(ReuseMap),
@@ -700,7 +717,7 @@
 	),
 
 	% 0. fetch the procinfo of the called procedure:
-	module_info_pred_proc_info( HLDS, PredId, ProcId, _, 
+	module_info_pred_proc_info( HLDS, PredId, ProcId, PredInfo, 
 					ProcInfo0),
 	% 1. find the tabled reuse for the called predicate
 	lookup_memo_reuse( PredId, ProcId, HLDS, FP0, FP,
@@ -726,7 +743,10 @@
 		YesNo = no
 	;
 		memo_reuse_rename( ProcInfo0, ActualVars, FormalMemo, 
-					Memo ), 
+					Memo0 ), 
+		pred_info_arg_types( PredInfo, FormalTypes) ,
+		memo_reuse_rename_types( FormalTypes, ActualTypes, 
+					Memo0, Memo),
 		% 3. compute the Live variables upon a procedure entry:
 		% 3.a. compute the full live set at the program point of
 		%      the call.
@@ -739,7 +759,7 @@
 		goal_info_get_lfu(Info0, LFUi),
 		goal_info_get_lbu(Info0, LBUi),
 		set__union(LFUi, LBUi, LUi),
-		pa_alias_as__live( LUi, LIVE0, Alias0, Live_i),
+		pa_alias_as__live( HLDS, ProcInfo, LUi, LIVE0, Alias0, Live_i),
 		% 3.b. project the live-set to the actual vars:
 		sr_live__project( ActualVars, Live_i, ActualLive_i ),
 		% 4. project the aliases to the actual vars
@@ -759,7 +779,8 @@
 		;
 			Pool = Pool0,
 	
-			examine_cause_of_missed_reuse( LBUi, LFUi, 
+			examine_cause_of_missed_reuse( HLDS, ProcInfo, 
+					LBUi, LFUi, 
 					StaticTerms, Memo, 
 					Cause ), 
 			
@@ -769,16 +790,21 @@
 		)
 	).
 
-:- pred examine_cause_of_missed_reuse( set(prog_var)::in, 
+:- pred examine_cause_of_missed_reuse( module_info::in, 
+			proc_info::in, 
 			set(prog_var)::in, 
 			set(prog_var)::in, 
+			set(prog_var)::in, 
 			memo_reuse::in, list(string)::out) is det. 
-examine_cause_of_missed_reuse( LFU, LBU, Static, Memo, Causes ) :- 
+examine_cause_of_missed_reuse( ModuleInfo, ProcInfo, 
+		LFU, LBU, Static, Memo, Causes ) :- 
 	( 
 		Memo = yes(Conditions) 
 	->
 		list__filter_map(
-			examine_cause_of_missed_condition(LFU, LBU, Static), 
+			examine_cause_of_missed_condition(ModuleInfo,
+						ProcInfo, 
+						LFU, LBU, Static), 
 			Conditions, 
 			Causes)
 	;
@@ -786,17 +812,22 @@
 		Causes = [Cause]
 	).
 
-:- pred examine_cause_of_missed_condition( set(prog_var)::in, 
+:- pred examine_cause_of_missed_condition( module_info::in, 
+			proc_info::in, 
+			set(prog_var)::in, 
 			set(prog_var)::in, 
 			set(prog_var)::in, 
 			reuse_condition::in, 
 			string::out) is semidet.
 
-examine_cause_of_missed_condition( LFU, LBU, StaticVars, Condition, Cause ) :- 
+examine_cause_of_missed_condition( ModuleInfo, ProcInfo, 
+		LFU, LBU, StaticVars, Condition, Cause ) :- 
 	sr_live__init(DummyLive), 
 	pa_alias_as__init( BottomAlias), 
-	pa_alias_as__live( LFU, DummyLive, BottomAlias, LFU_Live), 
-	pa_alias_as__live( LBU, DummyLive, BottomAlias, LBU_Live), 
+	pa_alias_as__live( ModuleInfo, ProcInfo, 
+			LFU, DummyLive, BottomAlias, LFU_Live), 
+	pa_alias_as__live( ModuleInfo, ProcInfo, 
+			LBU, DummyLive, BottomAlias, LBU_Live), 
 	Condition = condition( Nodes, _LU, _LA ), 
 	% 
 	NodesL = set__to_sorted_list(Nodes),
@@ -818,7 +849,8 @@
 		% check for LFU
 		list__filter(
 			( pred(D::in) is semidet :- 
-			  sr_live__is_live_datastruct( D, LFU_Live)
+			  sr_live__is_live_datastruct( ModuleInfo, 
+				ProcInfo, D, LFU_Live)
 			), 
 			NodesL, 
 			RF), 
@@ -831,7 +863,8 @@
 		% check LBU
 		list__filter(
 			( pred(D::in) is semidet :- 
-			  sr_live__is_live_datastruct( D, LBU_Live)
+			  sr_live__is_live_datastruct( ModuleInfo, 
+				ProcInfo, D, LBU_Live)
 			), 
 			NodesL, 
 			RB), 
Index: sr_live.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/sr_live.m,v
retrieving revision 1.1.2.1
diff -u -r1.1.2.1 sr_live.m
--- sr_live.m	2000/09/19 10:02:12	1.1.2.1
+++ sr_live.m	2001/02/07 08:15:24
@@ -23,6 +23,7 @@
 % compiler modules
 :- import_module prog_data.
 :- import_module pa_datastruct.
+:- import_module hlds_pred, hlds_module. 
 
 %-------------------------------------------------------------------%
 %-- exported types
@@ -58,8 +59,9 @@
 :- pred is_live(prog_var,live_set).
 :- mode is_live(in, in) is semidet.
 
-:- pred is_live_datastruct(pa_datastruct__datastruct, live_set).
-:- mode is_live_datastruct(in, in) is semidet.
+:- pred is_live_datastruct(module_info, proc_info, 
+			pa_datastruct__datastruct, live_set).
+:- mode is_live_datastruct(in, in, in, in) is semidet.
 
 :- pred project(list(prog_var), live_set, live_set).
 :- mode project(in, in, out) is det.
@@ -180,27 +182,15 @@
 		fail
 	).
 
-:- pred test_filter(datastruct, list(datastruct), list(datastruct)).
-:- mode test_filter(in, in, out) is det.
-
-test_filter( _, [], []).
-test_filter( D, [ X | Xs ], Result ):- 
-	test_filter( D, Xs, Rest), 
-	(
-		pa_datastruct__less_or_equal( D, X , _)
-	->
-		Result = [ X | Rest ]
-	;
-		Result = Rest
-	).
 		
-is_live_datastruct(Data, Live):- 
+is_live_datastruct(ModuleInfo, ProcInfo, Data, Live):- 
 	(
 		Live = live(Datastructs)
 	->
 		list__filter(
 			pred( D::in ) is semidet :- 
-			    ( pa_datastruct__less_or_equal(Data, D, _S) ),
+			    ( pa_datastruct__less_or_equal(ModuleInfo,
+					ProcInfo, Data, D, _S) ),
 			Datastructs,
 			R ),
 		R = [_ | _ ]
Index: sr_reuse_run.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/sr_reuse_run.m,v
retrieving revision 1.1.2.8
diff -u -r1.1.2.8 sr_reuse_run.m
--- sr_reuse_run.m	2000/10/12 15:03:48	1.1.2.8
+++ sr_reuse_run.m	2001/02/07 08:15:25
@@ -284,8 +284,14 @@
 				Info0, Info, 
 				FP0, FP)
 		),
+		proc_info_vartypes( ProcInfo, VarTypes ), 
+		list__map( 
+			map__lookup( VarTypes ), 
+			ActualVars, 
+			ActualTypes ), 
 		pa_run__extend_with_call_alias( HLDS, ProcInfo, 
-	    		PredId, ProcId, ActualVars, Alias0, Alias),
+	    		PredId, ProcId, ActualVars, 
+			ActualTypes, Alias0, Alias),
 		Expr = Expr0
 	;
 		% 3. generic_call --> see end
@@ -313,7 +319,7 @@
 		% 5. unification
 		Expr0 = unify(Var, Rhs, Mode, Unification0, Context)
 	->
-		unification_verify_reuse(Unification0, Alias0, 
+		unification_verify_reuse(HLDS, ProcInfo, Unification0, Alias0, 
 				Reuses0, Reuses, Info0, Info),
 		pa_alias_as__extend_unification(ProcInfo, HLDS, 
 				Unification, Info, Alias0, Alias),	
@@ -481,7 +487,7 @@
 		goal_info_get_lfu(Info0, LFUi),
 		goal_info_get_lbu(Info0, LBUi),
 		set__union(LFUi, LBUi, LUi),
-		pa_alias_as__live( LUi, LIVE0, Alias0, Live_i),
+		pa_alias_as__live( HLDS, ProcInfo, LUi, LIVE0, Alias0, Live_i),
 		% 3.b. project the live-set to the actual vars:
 		sr_live__project( ActualVars, Live_i, ActualLive_i ),
 		% 4. project the aliases to the actual vars
@@ -500,13 +506,15 @@
 		)
 	).
 				
-:- pred unification_verify_reuse( hlds_goal__unification, 
+:- pred unification_verify_reuse( module_info, proc_info, 
+			hlds_goal__unification, 
 			alias_as, reuses, reuses, 
 			hlds_goal_info, hlds_goal_info).
-:- mode unification_verify_reuse( in, in, in, out, in, out) is det.
+:- mode unification_verify_reuse( in, in, in, in, in, out, in, out) is det.
 
-unification_verify_reuse( Unification, Alias0, Reuses0, Reuses,
-				Info0, Info) :- 
+unification_verify_reuse( ModuleInfo, ProcInfo, 
+			Unification, Alias0, Reuses0, Reuses,
+			Info0, Info) :- 
 	(
 		Unification = deconstruct( Var, CONS_ID, _, _, _, _)
 	->
@@ -514,7 +522,8 @@
 		goal_info_get_lbu( Info0, LBU ),
 		set__union( LFU, LBU, LU), 
 		sr_live__init(LIVE0),
-		pa_alias_as__live(LU, LIVE0, Alias0, LIVE), 
+		pa_alias_as__live( ModuleInfo, ProcInfo, 
+				LU, LIVE0, Alias0, LIVE), 
 		(
 			sr_live__is_live(Var,LIVE)
 		->
Index: sr_run.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/sr_run.m,v
retrieving revision 1.1.2.6
diff -u -r1.1.2.6 sr_run.m
--- sr_run.m	2000/11/21 10:35:44	1.1.2.6
+++ sr_run.m	2001/02/07 08:15:25
@@ -123,14 +123,15 @@
 	{ proc_info_varset(ProcInfo, ProgVarset) },
 	{ proc_info_headvars(ProcInfo, HeadVars) },
 	{ list__delete_elems( HeadVars, TVars, RealHeadVars ) }, 
+	{ proc_info_vartypes( ProcInfo, VarTypes) }, 
+	{ pred_info_typevarset( PredInfo, TypeVarSet ) },
 
-	( { RealHeadVars = [] } ->
-		io__write_string("vars")
-	;
-		io__write_string("vars("),
-		mercury_output_vars(RealHeadVars, ProgVarset, no),
-		io__write_string(")")
-	),
+	pa_sr_util__trans_opt_output_vars_and_types(
+			ProgVarset, 
+			VarTypes, 
+			TypeVarSet, 
+			RealHeadVars ),
+
 	io__write_string(", "),
 
 		% write reuse information
Index: structure_reuse.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/structure_reuse.m,v
retrieving revision 1.1.2.7
diff -u -r1.1.2.7 structure_reuse.m
--- structure_reuse.m	2000/11/20 10:18:03	1.1.2.7
+++ structure_reuse.m	2001/02/07 08:15:25
@@ -96,7 +96,7 @@
 		[]
 	).
 
-:- import_module sr_data.	
+:- import_module sr_data, pa_sr_util.	
 :- import_module mercury_to_mercury, prog_data.
 
 :- pred write_pred_proc_sr_reuse_info( module_info, pred_id,
@@ -137,16 +137,15 @@
 
 	{ proc_info_varset(ProcInfo, ProgVarset) },
 	{ proc_info_real_headvars(ProcInfo, HeadVars) },
+	{ proc_info_vartypes( ProcInfo, VarTypes) }, 
+	{ pred_info_typevarset( PredInfo, TypeVarSet ) },
 
-	{ RealHeadVars = HeadVars }, 
+	pa_sr_util__trans_opt_output_vars_and_types(
+			ProgVarset, 
+			VarTypes, 
+			TypeVarSet, 
+			HeadVars ),
 
-	( { RealHeadVars = [] } ->
-		io__write_string("vars")
-	;
-		io__write_string("vars("),
-		mercury_output_vars(RealHeadVars, ProgVarset, no),
-		io__write_string(")")
-	),
 	io__write_string(", "),
 
 		% write reuse information
@@ -164,7 +163,7 @@
 	{ module_info_pred_proc_info(HLDS, ReusePredId, ReuseProcId,
 			_ReusePredInfo, ReuseProcInfo) },
 	{ proc_info_reuse_information(ReuseProcInfo, TREUSE) },
-	sr_data__memo_reuse_print( TREUSE, ReuseName, ReuseProcInfo) ,
+	sr_data__memo_reuse_print( TREUSE, ReuseName, ReuseProcInfo, PredInfo) ,
 
 	io__write_string(").\n").
 %-----------------------------------------------------------------------------%
Index: typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.281.2.4
diff -u -r1.281.2.4 typecheck.m
--- typecheck.m	2000/11/13 18:37:33	1.281.2.4
+++ typecheck.m	2001/02/07 08:15:28
@@ -324,6 +324,10 @@
 	    ( code_util__compiler_generated(PredInfo0),
 	      \+ special_pred_needs_typecheck(PredInfo0, ModuleInfo)
 	    ; code_util__predinfo_is_builtin(PredInfo0)
+		% reuse-predicates are created based on non-reuse ones. 
+	     	% If the non-reuse ones are type correct (and thus they
+		% must be verified), the reuse ones will be too.
+	    ; code_util__reuse_compiler_generated(PredInfo0)
 	    )
 	->
 	    pred_info_clauses_info(PredInfo0, ClausesInfo0),

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



More information about the developers mailing list