[m-dev.] [reuse] change of the alias representation
Nancy Mazur
Nancy.Mazur at cs.kuleuven.ac.be
Tue Mar 6 04:06:35 AEDT 2001
Hi,
===================================================================
Estimated hours taken: 40
As the alias-analysis time was really totally unbearable, we finally
made the intelligent decision of changing our alias-representation.
While the set of aliases used to be represented as a list of pairs
of datastructures, we now changed this using maps.
The effect of this change is quite exciting. The compilation (analysis) of
the module tree123 took ages (more exactly, about 2 hours), which is
now reduced to some 8 minutes (no widening).
Compilation of other problematic modules also showed a real
time-gain (example: peephole in the icfp2000 entry).
pa_alias_set.m:
New module. This module contains the new alias-set
representation. In this representation, each variable which
has some aliases is mapped to a map of selectors.
Each map of selectors maps a selector unto the datastructures
the variable+selector is aliased with.
pa_alias.m:
This module still contains the definition of a single alias
as a pair of datastructures.
At some point it has to be cleaned up as pa_alias_set now
defines most of the predicates which where defined in here.
pa_alias_as.m:
Use pa_alias_set. Prevent widening from occurring (setting
the limit of the alias-set size very high).
pa_datastruct.m:
Some cleanups, and more logical organization.
pa_selector.m:
Some cleanups, and more logical organization.
Also bugfix wrt type-widening.
pa_run.m:
pa_sr_util.m:
Minor.
Index: pa_alias.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/pa_alias.m,v
retrieving revision 1.1.2.5
diff -u -r1.1.2.5 pa_alias.m
--- pa_alias.m 2001/02/13 14:31:20 1.1.2.5
+++ pa_alias.m 2001/03/05 16:52:01
@@ -29,7 +29,8 @@
%-------------------------------------------------------------------%
%-- exported types
-:- type alias.
+% :- type alias.
+:- type alias == pair(datastruct).
%-------------------------------------------------------------------%
%-- exported predicates
@@ -188,7 +189,7 @@
%-------------------------------------------------------------------%
%-- type definitions
-:- type alias == pair(datastruct).
+%:- type alias == pair(datastruct).
%-------------------------------------------------------------------%
@@ -631,12 +632,41 @@
1, _ ).
from_unification( _ProcInfo, _HLDS,
- construct( VAR, CONS, ARGS, _, _, _, _ ), _Info, AS ) :-
+ 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).
+:- 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 ) :-
+ cons_id_maybe_arity( Cons, MaybeArity ),
+ (
+ MaybeArity = yes( RealArity )
+ ->
+ list__length( Args0, PseudoArity),
+ (
+ RealArity = PseudoArity
+ ->
+ Args = Args0
+ ;
+ Diff = PseudoArity - RealArity,
+ (
+ list__drop( Diff, Args0, Args1 )
+ ->
+ Args = Args1
+ ;
+ require__error("Blabla")
+ )
+ )
+ ;
+ Args = Args0
+ ).
+
+
from_unification( _ProcInfo, _HLDS,
- deconstruct( VAR, CONS, ARGS, _, _, _ ), Info, AS) :-
+ deconstruct( VAR, CONS, ARGS0, _, _, _ ), Info, AS) :-
+ get_rid_of_damn_typeinfos( CONS, ARGS0, ARGS),
number_args( ARGS, NUMBEREDARGS),
optimize_for_deconstruct(NUMBEREDARGS, Info, ReducedARGS),
list__foldl( alias_from_unif(VAR,CONS),ReducedARGS, [], AS).
@@ -700,15 +730,20 @@
keep_only_the_prebirths_v2( PreB, AllArgs, RES ) :-
set__to_sorted_list( PreB, ListPreB),
+ /**
+ % This length-test is not correct anymore in the presence
+ % of those *LLFD* typeinfos.
list__length( ListPreB, L1),
list__length( AllArgs, L2),
+
(
L1 = L2
->
RES = AllArgs
;
- keep_only_the_prebirths_v2_2( ListPreB, AllArgs, [], RES)
- ).
+ **/
+ keep_only_the_prebirths_v2_2( ListPreB, AllArgs, [], RES).
+
:- pred keep_only_the_prebirths_v2_2( list(prog_var),
list(pair(int, prog_var)),
@@ -720,9 +755,16 @@
(
PreB = [ X | Xs ]
->
- list_find( X, Arg, AllArgs, AllArgs0),
- ACC0 = [ Arg | ACC ],
- keep_only_the_prebirths_v2_2( Xs, AllArgs0, ACC0, RES)
+ (
+ list_find( X, Arg, AllArgs, AllArgs0)
+ ->
+ ACC0 = [ Arg | ACC ],
+ AllArgs1 = AllArgs0
+ ;
+ ACC0 = ACC,
+ AllArgs1 = AllArgs
+ ),
+ keep_only_the_prebirths_v2_2( Xs, AllArgs1, ACC0, RES)
;
RES = ACC
).
@@ -730,23 +772,18 @@
:- pred list_find( prog_var, pair(int, prog_var),
list(pair(int, prog_var)),
list(pair(int, prog_var))).
-:- mode list_find( in, out, in, out) is det.
+:- mode list_find( in, out, in, out) is semidet.
list_find( Var, Arg, Lin, Lout) :-
+ Lin = [ First | Rest ],
(
- Lin = [ First | Rest ]
+ First = std_util:'-'(_, Var)
->
- (
- First = std_util:'-'(_, Var)
- ->
- Arg = First,
- Lout = Rest
- ;
- list_find( Var, Arg, Rest, Tmp),
- Lout = [ First | Tmp ]
- )
+ Arg = First,
+ Lout = Rest
;
- require__error("(pa_alias) list_find: could not find prog_var in list of args.")
+ list_find( Var, Arg, Rest, Tmp),
+ Lout = [ First | Tmp ]
).
Index: pa_alias_as.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/pa_alias_as.m,v
retrieving revision 1.1.2.10
diff -u -r1.1.2.10 pa_alias_as.m
--- pa_alias_as.m 2001/02/13 14:31:21 1.1.2.10
+++ pa_alias_as.m 2001/03/05 16:52:02
@@ -59,12 +59,6 @@
alias_as, list(pa_datastruct__datastruct)).
:- 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
- % Y \in Vars
-:- pred extend_prog_vars_from_alias( set(prog_var), alias_as, set(prog_var)).
-:- mode extend_prog_vars_from_alias( in, in, out) is det.
-
% rename abstract substitution according to a mapping
% of prog_vars (map (FROM_VARS, TO_VARS) ).
:- pred rename( map(prog_var, prog_var), alias_as, alias_as).
@@ -86,8 +80,14 @@
:- pred equal( alias_as, alias_as).
:- mode equal( in, in) is semidet.
+ % less_or_equal( ModuleInfo, ProcInfo, AliasAs1, AliasAs2 ).
% first abstract subst. is less than or equal to second
- % abstract subst. (for fixpoint). (not used)
+ % abstract subst. (for fixpoint). i.e. The first abstract
+ % substitution expresses less than the second one: for each
+ % alias Alias1 expressed by AliasAs1, there exists an alias
+ % Alias2 from AliasAs2 such that Alias1 is tighter than
+ % Alias2. And there are no aliases from AliasAs2 which are not
+ % greater than any of the aliases from AliasAs1.
:- pred less_or_equal( module_info, proc_info, alias_as, alias_as).
:- mode less_or_equal( in, in, in, in) is semidet.
@@ -178,12 +178,13 @@
% compiler modules
:- import_module pa_alias, pa_util, pa_sr_util.
+:- import_module pa_alias_set.
%-----------------------------------------------------------------------------%
%-- type definitions
:- type alias_as --->
- real_as( list(alias) )
+ real_as( alias_set )
; bottom
; top(list(string)).
% where list(alias) contains no doubles!
@@ -204,7 +205,7 @@
% is_bottom
is_bottom(bottom).
-is_bottom(real_as([])).
+is_bottom(real_as(AliasSet) ):- pa_alias_set__is_empty(AliasSet).
% top
top( Msg, top([NewMsg]) ):-
@@ -239,17 +240,16 @@
size( bottom ) = 0.
size( top(_) ) = 999999.
-size( real_as( LIST ) ) = L :-
- list__length( LIST, L ).
+size( real_as( AliasSet ) ) = L :-
+ pa_alias_set__get_size(AliasSet, L).
% project
project( Listvar, ASin , ASout):-
(
- ASin = real_as(Aliases)
+ ASin = real_as(AliasSet0)
->
- list__filter( pa_alias__contains_vars( Listvar ), Aliases,
- PAliases),
- wrap( PAliases, ASout)
+ pa_alias_set__project( Listvar, AliasSet0, AliasSet),
+ wrap( AliasSet, ASout)
;
% ASin is bottom or top(_)
ASout = ASin
@@ -259,56 +259,29 @@
set__to_sorted_list( SetVar, ListVar),
project( ListVar, ASin, ASout).
-collect_aliases_of_datastruct( ModuleInfo, ProcInfo, DATA, AS, LIST ):-
+collect_aliases_of_datastruct( ModuleInfo, ProcInfo, Datastruct, AS,
+ AliasList ):-
(
- AS = real_as(ALIASES)
+ AS = real_as(AliasSet)
->
- list__filter_map(
- pred( A::in, D::out) is semidet :-
- ( pa_alias__aliased_to( ModuleInfo, ProcInfo,
- A, DATA, D)),
- ALIASES,
- LIST)
+ pa_alias_set__collect_aliases_of_datastruct( ModuleInfo,
+ ProcInfo, Datastruct, AliasSet, AliasList )
;
is_bottom(AS)
->
- LIST = []
+ AliasList = []
;
% is_top
error("(pa_alias_as) collect_aliases_of_datastruct: alias_as is top.")
).
-
-extend_prog_vars_from_alias( VarsIN, AS, VarsOUT):-
- (
- AS = real_as( LIST )
- ->
- VarsOUT = set__fold(
- extend_prog_var_from_alias_list(LIST),
- VarsIN,
- VarsIN)
- ;
- VarsOUT = VarsIN
- ).
-
-:- func extend_prog_var_from_alias_list( list(alias), prog_var,
- set(prog_var)) = set(prog_var).
-:- mode extend_prog_var_from_alias_list( in, in, in) = out is det.
-
-extend_prog_var_from_alias_list( AS, Var, Vars) = NewVars :-
- list__foldl(
- pa_alias__extend_prog_var_from_alias(Var),
- AS,
- Vars,
- NewVars).
-rename( Mapvar, ASin, ASout ):-
+rename( MapVar, ASin, ASout ):-
(
ASin = real_as(Aliases)
->
- list__map( pa_alias__rename( Mapvar ),
- Aliases, RAliases),
+ pa_alias_set__rename( MapVar, Aliases, RAliases),
wrap(RAliases, ASout)
;
% ASin is bottom or top(_)
@@ -324,13 +297,11 @@
rename_types( Substitution, A0, A) :-
(
- A0 = real_as( Aliases0 )
+ A0 = real_as( AliasSet0 )
->
- list__map(
- pa_alias__rename_types(Substitution),
- Aliases0,
- Aliases ),
- A = real_as( Aliases )
+ pa_alias_set__rename_types( Substitution, AliasSet0,
+ AliasSet ),
+ A = real_as( AliasSet)
;
A = A0
).
@@ -338,16 +309,9 @@
equal( AS1, AS2 ):-
(
- AS1 = real_as(LIST1)
- ->
- AS2 = real_as(LIST2),
- list__length(LIST1, L),
- list__length(LIST2, L),
- list__takewhile(
- pred(AL::in) is semidet :-
- ( pa_alias__occurs_in(AL, LIST2)),
- LIST1,_, AfterList),
- AfterList = []
+ AS1 = real_as(AliasSet1),
+ AS2 = real_as(AliasSet2),
+ pa_alias_set__equal( AliasSet1, AliasSet2 )
;
% AS1 is bottom or top(_)
( AS1 = bottom, AS2 = bottom)
@@ -357,30 +321,24 @@
less_or_equal( ModuleInfo, ProcInfo, AS1, AS2 ):-
(
- AS1 = real_as(LIST1)
- ->
- AS2 = real_as(LIST2),
- list__takewhile(
- pred(AL::in) is semidet :-
- ( pa_alias__subsumed_by_list(ProcInfo,
- ModuleInfo,AL, LIST2)),
- LIST1,_,
- AfterList),
- AfterList = []
+ AS1 = real_as(AliasSet1),
+ AS2 = real_as(AliasSet2),
+ pa_alias_set__less_or_equal( ModuleInfo, ProcInfo,
+ AliasSet1, AliasSet2 )
;
( AS1 = bottom ; AS2 = top(_) )
).
least_upper_bound( ProcInfo, HLDS, AS1, AS2, RESULT) :-
(
- AS1 = real_as(LIST1)
+ AS1 = real_as(AliasSet1)
->
(
- AS2 = real_as(LIST2)
+ AS2 = real_as(AliasSet2)
->
- pa_alias__least_upper_bound_lists(ProcInfo,
- HLDS, LIST1,LIST2,Aliases),
- wrap_and_control( HLDS, ProcInfo, Aliases, RESULT)
+ pa_alias_set__least_upper_bound( HLDS, ProcInfo,
+ AliasSet1, AliasSet2, AliasSet ),
+ wrap_and_control( HLDS, ProcInfo, AliasSet, RESULT)
;
AS2 = top(_)
->
@@ -404,61 +362,10 @@
RESULT = AS2
).
-:- pred simplify_upon_subsumption(proc_info, module_info,
- alias_as, alias_as).
-:- mode simplify_upon_subsumption(in,in,in,out) is det.
-
-simplify_upon_subsumption( ProcInfo, HLDS, AS, RESULT):-
- (
- AS = real_as(LIST)
- ->
- pa_alias__least_upper_bound_lists(ProcInfo,HLDS,
- LIST,[],Aliases),
- wrap_and_control(HLDS, ProcInfo, Aliases,RESULT)
- ;
- % AS is bottom or top(_)
- RESULT = AS
- ).
-
-least_upper_bound_list( ProcInfo, HLDS, GoalInfo, Alias_list0, AS ) :-
- list__map(
- maybe_normalize( ProcInfo, HLDS, GoalInfo ),
- Alias_list0,
- Alias_list),
- list__foldl(least_upper_bound(ProcInfo, HLDS) , Alias_list,
+least_upper_bound_list( ProcInfo, HLDS, _GoalInfo, Alias_list0, AS ) :-
+ list__foldl(least_upper_bound(ProcInfo, HLDS) , Alias_list0,
bottom, AS).
-:- pred maybe_normalize( proc_info, module_info, hlds_goal_info,
- alias_as, alias_as).
-:- mode maybe_normalize( in, in, in, in, out ) is det.
-
-maybe_normalize( ProcInfo, HLDS, GoalInfo, Alias0, Alias ) :-
- (
- Alias0 = top(_),
- Alias = Alias0
- ;
- Alias0 = bottom,
- Alias = Alias0
- ;
- Alias0 = real_as(AliasList0),
- SIZE = size(Alias0),
- (
- SIZE > top_limit
- ->
- pa_alias__apply_widening_list( HLDS, ProcInfo,
- AliasList0, AliasList ),
- Alias = real_as(AliasList)
- % top("Size too big", Alias)
- ;
- SIZE > alias_limit
- ->
- normalize_with_goal_info( ProcInfo, HLDS, GoalInfo,
- Alias0, Alias)
- ;
- Alias = Alias0
- )
- ).
-
extend(ProcInfo, HLDS, A1, A2, RESULT ):-
(
A1 = real_as(NEW)
@@ -466,7 +373,7 @@
(
A2 = real_as(OLD)
->
- pa_alias__extend(ProcInfo, HLDS,
+ pa_alias_set__extend(HLDS, ProcInfo,
NEW, OLD, Aliases),
wrap_and_control(HLDS, ProcInfo, Aliases, RESULT)
;
@@ -495,13 +402,13 @@
add( AS1, AS2, AS ) :-
(
- AS1 = real_as( List1)
+ AS1 = real_as( AliasSet1)
->
(
- AS2 = real_as( List2 )
+ AS2 = real_as( AliasSet2 )
->
- list__append(List1, List2, List),
- AS = real_as( List )
+ pa_alias_set__add( AliasSet1, AliasSet2, AliasSet),
+ AS = real_as( AliasSet )
;
AS2 = bottom
->
@@ -522,8 +429,8 @@
%-----------------------------------------------------------------------------%
extend_unification( ProcInfo, HLDS, Unif, GoalInfo, ASin, ASout ):-
pa_alias__from_unification( ProcInfo, HLDS, Unif, GoalInfo, AUnif),
- wrap(AUnif, ASUnif),
-% extend( ProcInfo, HLDS, ASUnif, ASin, ASout).
+ pa_alias_set__from_pair_alias_list( AUnif, AliasSetUnif ),
+ wrap(AliasSetUnif, ASUnif),
extend( ProcInfo, HLDS, ASUnif, ASin, ASout0),
(
Unif = construct(_, _, _, _, _, _, _)
@@ -551,22 +458,14 @@
->
ASout = ASin
;
-
- list__filter(
- does_not_contain_vars( DeathsList ),
- Aliases0,
- Aliases),
+ pa_alias_set__remove_vars( DeathsList, Aliases0,
+ Aliases),
wrap(Aliases, ASout)
)
;
ASout = ASin
).
-:- pred does_not_contain_vars( list(prog_var), alias).
-:- mode does_not_contain_vars( in, in) is semidet.
-
-does_not_contain_vars( Vars, Alias) :-
- not contains_one_of_vars_in_list( Vars, Alias).
%-----------------------------------------------------------------------------%
extend_foreign_code( _ProcInfo, HLDS, GoalInfo,
@@ -711,10 +610,7 @@
normalize( ProcInfo, HLDS, _InstMap, Alias0, Alias):-
% normalize only using type-info's
- normalize_wti( ProcInfo, HLDS, Alias0, Alias1),
- % removing doubles is not enough -- subsumption should
- % be verified.
- simplify_upon_subsumption( ProcInfo, HLDS, Alias1, Alias).
+ normalize_wti( ProcInfo, HLDS, Alias0, Alias).
:- pred normalize_wti( proc_info, module_info, alias_as, alias_as).
:- mode normalize_wti( in, in, in, out) is det.
@@ -723,8 +619,8 @@
(
ASin = real_as(Aliases0)
->
- list__map(pa_alias__normalize_wti(ProcInfo, HLDS), Aliases0,
- Aliases),
+ pa_alias_set__normalize( HLDS, ProcInfo, Aliases0,
+ Aliases),
wrap(Aliases, ASout)
;
ASout = ASin
@@ -756,8 +652,8 @@
(
{ AS = real_as(Aliases) }
->
- io__write_list( Aliases, "",
- pa_alias__print(ProcInfo, PredInfo, "% ", "\n"))
+ pa_alias_set__print( PredInfo, ProcInfo, Aliases,
+ "% ", "\n" )
;
{ AS = top(Msgs) }
->
@@ -790,8 +686,8 @@
{ AS = real_as(Aliases) }
->
io__write_string("["),
- io__write_list( Aliases, ",",
- pa_alias__print(ProcInfo,PredInfo," ","")),
+ pa_alias_set__print( PredInfo, ProcInfo, Aliases,
+ " ", ""),
io__write_string("]")
;
{ AS = top(_Msgs) }
@@ -828,7 +724,9 @@
CONS = "."
->
parse_list_alias_term( OneITEM, Aliases),
- wrap(Aliases, AS)
+ pa_alias_set__from_pair_alias_list( Aliases,
+ AliasSet ),
+ wrap(AliasSet, AS)
% AS = bottom
;
CONS = "bottom"
@@ -882,12 +780,12 @@
).
-:- pred wrap( list(alias), alias_as).
+:- pred wrap( pa_alias_set__alias_set, alias_as).
:- mode wrap( in, out) is det.
-wrap( LIST, AS) :-
+wrap( AliasSet, AS) :-
(
- LIST = []
+ pa_alias_set__get_size( AliasSet, 0 )
->
AS = bottom
;
@@ -896,14 +794,14 @@
% ->
% top("Size too big", AS)
% ;
- AS = real_as(LIST)
+ AS = real_as(AliasSet)
).
:- pred wrap_and_control( module_info::in, proc_info::in,
- list(alias)::in, alias_as::out) is det.
+ alias_set::in, alias_as::out) is det.
-wrap_and_control( _ModuleInfo, _ProcInfo, AliasList, AS ):-
- wrap( AliasList, AS ).
+wrap_and_control( _ModuleInfo, _ProcInfo, AliasSet, AS ):-
+ wrap( AliasSet, AS ).
/**
(
AliasList = []
@@ -948,8 +846,9 @@
;
% most general case
- AS = real_as(Aliases)
+ AS = real_as(AliasSet)
->
+ pa_alias_set__to_pair_alias_list( AliasSet, Aliases),
live_2(ModuleInfo, ProcInfo, IN_USE, LIVE_0, Aliases, LIVE)
;
error("(pa_alias_as) live: impossible situation.")
Index: pa_alias_set.m
===================================================================
RCS file: pa_alias_set.m
diff -N pa_alias_set.m
--- /dev/null Wed Nov 15 09:24:47 2000
+++ pa_alias_set.m Tue Mar 6 03:52:03 2001
@@ -0,0 +1,1196 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001 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_alias_set: defines the datastructure alias_set which represents
+% a set of aliases. This module will replace the
+% module pa_alias which only took care of representing
+% one single alias. In this new representation we will
+% not represent single aliases anymore.
+% main author: nancy
+
+% TO DO:
+% - record type of the selectorset immediately in the set.
+
+:- module pa_alias_set.
+
+:- interface.
+
+%-----------------------------------------------------------------------------%
+%-- import_module
+
+% library modules
+:- import_module list, set, map, io, term.
+
+% compiler modules
+:- import_module pa_datastruct.
+:- import_module hlds_module, hlds_pred.
+:- import_module prog_data.
+:- import_module pa_alias.
+
+
+%-----------------------------------------------------------------------------%
+%-- exported types
+
+:- type alias_set.
+% :- type alias == pair(pa_datastruct__datastruct, pa_datastruct__datastruct).
+
+%-----------------------------------------------------------------------------%
+%-- exported predicates
+
+:- pred init( alias_set::out) is det.
+:- func init = alias_set is det.
+:- pred is_empty( alias_set::in) is semidet.
+:- pred get_size( alias_set::in, int::out) is det.
+
+ % conversion between list of aliases to alias_set's
+:- pred from_pair_alias_list( list(alias)::in, alias_set::out) is det.
+:- pred to_pair_alias_list( alias_set::in, list(alias)::out) is det.
+
+ % projection-operations. Given a list or set of prog_vars,
+ % keep only that part of the alias_set which relates to those
+ % prog_vars.
+:- pred project( list(prog_var)::in, alias_set::in, alias_set::out ) is det.
+:- pred project_set( set(prog_var)::in, alias_set::in,
+ alias_set::out) is det.
+
+ % compute all the datastructures to which a certain datastruct
+ % is aliased. This returns a list of datastructs.
+:- pred collect_aliases_of_datastruct( module_info::in, proc_info::in,
+ pa_datastruct__datastruct::in, alias_set::in,
+ list(pa_datastruct__datastruct)::out) is det.
+
+ % rename the prog_vars occurring in the alias_set, using
+ % a map which maps the to-be-replaced-vars with unto the
+ % new prog_vars.
+:- pred rename( map(prog_var,prog_var)::in, alias_set::in,
+ alias_set::out) is det.
+
+ % rename the types occurring in the alias_set, applying
+ % the given substitution to each of the types encountered.
+:- pred rename_types( term__substitution(tvar_type)::in,
+ alias_set::in, alias_set::out) is det.
+
+ % equality test. Needed for the fixpoint computation.
+:- pred equal( alias_set::in, alias_set::in) is semidet.
+
+ % compute the least upper bound of alias_sets.
+:- pred least_upper_bound( module_info::in, proc_info::in,
+ alias_set::in, alias_set::in, alias_set::out) is det.
+:- pred least_upper_bound_list( module_info::in, proc_info::in,
+ list(alias_set)::in, alias_set::out) is det.
+
+ % extend( ModuleInfo, ProcInfo, NewAliasSet, OldAliasSet,
+ % ComputedAliasSet).
+ % Extend a given OldAliasSet with the information contained
+ % in the NewAliasSet. Note that order here is very important!
+ % The NewAliasSet is the alias_set which was computed for
+ % one specific atom. This information needs to be computed
+ % with the aliases which already existed at the program point
+ % corresponding with this atom (the OldAliasSet).
+ % ==> alternating closure.
+:- pred extend( module_info::in, proc_info::in, alias_set::in,
+ alias_set::in, alias_set::out) is det.
+
+ % add two alias_sets together without bothering to extend
+ % one against the other.
+:- pred add( alias_set::in, alias_set::in, alias_set::out) is det.
+
+ % normalize all the selectors within the alias_set and
+ % simplify if necessary.
+:- pred normalize( module_info::in, proc_info::in,
+ alias_set::in, alias_set::out) is det.
+
+ % less_or_equal( ModuleInfo, ProcInfo, AliasSet1, AliasSet2).
+:- pred less_or_equal( module_info::in, proc_info::in,
+ alias_set::in, alias_set::in) is semidet.
+
+ % remove all the information regading the given list of
+ % variables.
+:- pred remove_vars( list(prog_var)::in, alias_set::in,
+ alias_set::out ) is det.
+
+ % printing predicates
+
+ % print( PredInfo, ProcInfo, AliasSet, StartingString, EndString )
+ % Prints each alias as a parsable pair of datastructs, each
+ % alias preceded with the StartingString, and ended with the
+ % EndString.
+:- pred print( pred_info::in, proc_info::in, alias_set::in,
+ string::in, string::in,
+ io__state::di, io__state::uo) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+%-----------------------------------------------------------------------------%
+%-- import module
+
+% library modules
+:- import_module std_util.
+:- import_module int, bool, assoc_list.
+
+% compiler modules
+:- import_module pa_selector.
+
+%-----------------------------------------------------------------------------%
+%-- type definitions
+
+ % the alias set is represented as a mapping: each prog_var is
+ % associated with a new set representing the structures with
+ % which is aliased.
+:- type alias_set --->
+ alias_set(
+ int, % total number of aliases
+ % represented by this set.
+% set(prog_var), % all the vars involved
+ map(prog_var, alias_set2)
+ % the actual mapping
+ ).
+
+ % the structures with which a variable can be aliased are
+ % represented by a new mapping: for each selector of that
+ % precise variable, we keep track of the datastructures
+ % with which it is aliased.
+:- type alias_set2 --->
+ alias_sel_set(
+ int,
+ map(selector,data_set)
+ ).
+
+:- type data_set --->
+ datastructs(
+ int,
+ set(datastruct)
+ ).
+
+%-----------------------------------------------------------------------------%
+%-- predicate definitions
+
+pa_alias_set__init( Init ) :- Init = pa_alias_set__init.
+pa_alias_set__init = alias_set( 0, map__init ).
+pa_alias_set__is_empty( alias_set( 0, Map ) ):- map__is_empty( Map ).
+pa_alias_set__get_size( alias_set( Size, _) , Size).
+
+pa_alias_set__from_pair_alias_list( Aliases, AliasSet ):-
+ pa_alias_set__new_entries( Aliases, pa_alias_set__init, AliasSet).
+
+:- pred pa_alias_set__new_entries( list(alias)::in,
+ alias_set::in, alias_set::out) is det.
+pa_alias_set__new_entries( Aliases, AliasSet0, AliasSet) :-
+ list__foldl(
+ pa_alias_set__new_entry,
+ Aliases,
+ AliasSet0,
+ AliasSet ).
+
+ % Alias = From - To
+ % This will be entered as From = Var - Selector --> To in DataSet
+:- pred pa_alias_set__new_directed_entries( list(alias)::in,
+ alias_set::in, alias_set::out ) is det.
+pa_alias_set__new_directed_entries( Aliases, AliasSet0, AliasSet):-
+ list__foldl(
+ pred( A::in, S0::in, S::out) is det:-
+ (
+ A = From - To,
+ pa_alias_set__new_entry( From, To, S0, S )
+ ),
+ Aliases,
+ AliasSet0,
+ AliasSet ).
+
+
+
+:- pred pa_alias_set__new_entry( alias::in, alias_set::in,
+ alias_set::out) is det.
+pa_alias_set__new_entry( Alias, AliasSet0, AliasSet ):-
+ Alias = Data1 - Data2,
+ pa_alias_set__new_entry( Data1, Data2, AliasSet0, AliasSet1 ),
+ (
+ pa_datastruct__equal( Data1, Data2 )
+ ->
+ AliasSet = AliasSet1
+ ;
+ pa_alias_set__new_entry( Data2, Data1, AliasSet1, AliasSet )
+ ).
+
+:- pred pa_alias_set__new_entry( datastruct::in, datastruct::in,
+ alias_set::in, alias_set::out ) is det.
+pa_alias_set__new_entry( FromData, ToData, AliasSet0, AliasSet ):-
+ AliasSet0 = alias_set( Size0, Map0 ),
+ get_var( FromData, Var ),
+ get_selector( FromData, Selector),
+ (
+ map__search( Map0, Var, Selectors0 )
+ ->
+ alias_set2_new_entry( Selector, ToData, Selectors0, Added,
+ Selectors ),
+ (
+ Added = yes
+ ->
+ map__det_update( Map0, Var, Selectors, Map ),
+ Size = Size0 + 1
+ ;
+ Map = Map0,
+ Size = Size0
+ )
+ ;
+ alias_set2_empty( Selectors0 ),
+ alias_set2_new_entry( Selector, ToData, Selectors0,
+ Selectors ),
+ map_det_insert( Map0, Var, Selectors, Map,
+ "(pa_alias_set) pa_alias_set__new entry/4"),
+ Size = Size0 + 1
+ ),
+ AliasSet = alias_set( Size, Map ).
+
+to_pair_alias_list( AliasSet, Aliases ):-
+ AliasSet = alias_set( _, Map ),
+ map__to_assoc_list( Map, Pairs ),
+ list__foldl(
+ pred( Pair::in, S0::in, S::out ) is det :-
+ (
+ Pair = Var - Selectors,
+ term__var_to_int( Var, VarInt),
+ alias_set2_unfold( Selectors, SelDatas ),
+ list__filter_map(
+ pred( SelData::in, Alias::out ) is semidet:-
+ (
+ SelData = Selector - Datastruct,
+ pa_datastruct__get_var( Datastruct,
+ DataVar ),
+ term__var_to_int( DataVar,
+ DataVarInt),
+ DataVarInt =< VarInt,
+ pa_datastruct__create( Var,
+ Selector, NewDatastruct),
+ Alias = NewDatastruct - Datastruct
+ ),
+ SelDatas,
+ Aliases0 ),
+ set__insert_list( S0, Aliases0, S )
+ ),
+ Pairs,
+ set__init,
+ AliasesSet),
+ set__to_sorted_list( AliasesSet, Aliases ).
+
+project( Vars, AliasSet0, AliasSet ):-
+ AliasSet0 = alias_set(_, Map0),
+ map__select( Map0, set__list_to_set(Vars ), Map1),
+ map__foldl(
+ pred( Var::in, SelSet0::in, M0::in, M::out) is det :-
+ (
+ alias_set2_project(Vars, SelSet0, SelSet),
+ (
+ alias_set2_empty(SelSet)
+ ->
+ M = M0
+ ;
+ map_det_insert( M0, Var, SelSet, M,
+ "(pa_alias_set) project/3")
+ )
+ ),
+ Map1,
+ map__init,
+ Map),
+ recount( alias_set(0, Map), AliasSet ).
+
+
+:- pred pa_alias_set__recount( alias_set::in, alias_set::out) is det.
+
+pa_alias_set__recount(AliasSet0, AliasSet):-
+ AliasSet0 = alias_set( _, Map ),
+ map__foldl(
+ pred( _K::in, Selectors::in,
+ Counter0::in, Counter::out) is det :-
+ (
+ alias_set2_get_size( Selectors, S ),
+ Counter = Counter0 + S
+ ),
+ Map,
+ 0,
+ Size),
+ AliasSet = alias_set( Size, Map ).
+
+project_set( VarsSet, AliasSet0, AliasSet ):-
+ set__to_sorted_list( VarsSet, Vars ),
+ project( Vars, AliasSet0, AliasSet).
+
+collect_aliases_of_datastruct( ModuleInfo, ProcInfo, Datastruct,
+ AliasSet, Datastructs):-
+ AliasSet = alias_set( _Size, Map ),
+ get_var(Datastruct, Var),
+ proc_info_vartypes( ProcInfo, VarTypes),
+ map__lookup( VarTypes, Var, VarType),
+ get_selector(Datastruct, Selector),
+ (
+ map__search( Map, Var, SelectorSet )
+ ->
+ alias_set2_collect_aliases( ModuleInfo, VarType,
+ Selector, SelectorSet, Datastructs)
+ ;
+ Datastructs = []
+ ).
+
+rename( Dict, AliasSet0, AliasSet ):-
+ AliasSet0 = alias_set( Size, Map0 ),
+ map__foldl(
+ pred( Var0::in, SelectorSet0::in, M0::in, M::out ) is det:-
+ (
+ alias_set2_rename(Dict, SelectorSet0,
+ SelectorSet1),
+ map__lookup( Dict, Var0, Var ),
+ (
+ map__search( M0, Var, SelectorSet2 )
+ ->
+ % can occur when 2 vars are renamed to
+ % the same var (call: append(X,X,Y))
+ alias_set2_add( SelectorSet1,
+ SelectorSet2, SelectorSet ),
+ map__det_update( M0, Var, SelectorSet, M )
+ ;
+ map_det_insert( M0, Var, SelectorSet1, M,
+ "(pa_alias_set) rename/3")
+ )
+ ),
+ Map0,
+ map__init,
+ Map),
+ AliasSet = alias_set( Size, Map ).
+
+rename_types( Subst, AliasSet0, AliasSet ):-
+ alias_set_map_values( alias_set2_rename_types(Subst), AliasSet0,
+ AliasSet).
+
+equal( AliasSet0, AliasSet1 ):-
+ AliasSet0 = alias_set( Size, Map0 ),
+ AliasSet1 = alias_set( Size, Map1 ),
+ map__keys( Map0, Keys0 ),
+ map__values( Map0, Values0),
+ equal2( Keys0, Values0, Map1).
+:- pred equal2( list(prog_var)::in, list(alias_set2)::in,
+ map( prog_var, alias_set2 )::in) is semidet.
+equal2( [], [], Map) :- map__is_empty( Map ).
+equal2( [ Var0 | Vars ], [SelectorSet0 | SelectorSets], Map0 ) :-
+ map__remove( Map0, Var0, SelectorSet1, Map ),
+ alias_set2_equal( SelectorSet0, SelectorSet1 ),
+ equal2( Vars, SelectorSets, Map ).
+
+least_upper_bound( ModuleInfo, ProcInfo, AliasSet0, AliasSet1, AliasSet):-
+ AliasSet0 = alias_set( Size0, Map0),
+ AliasSet1 = alias_set( Size1, Map1),
+ (
+ Size0 < Size1
+ ->
+ least_upper_bound2( ModuleInfo, ProcInfo, Map0, Map1, AliasSet)
+ ;
+ least_upper_bound2( ModuleInfo, ProcInfo, Map1, Map0, AliasSet)
+ ).
+
+ % least_upper_bound2(ModuleInfo, ProcInfo, SmallMap, BigMap, Result).
+:- pred least_upper_bound2( module_info::in, proc_info::in,
+ map( prog_var, alias_set2 )::in,
+ map( prog_var, alias_set2 )::in,
+ alias_set::out) is det.
+
+least_upper_bound2( ModuleInfo, ProcInfo, Map0, Map1, AliasSet ):-
+ map__keys( Map0, Vars),
+ list__foldl(
+ pred( Var::in, M0::in, M::out) is det :-
+ (
+ map__lookup( Map0, Var, SelectorSet0 ),
+ (
+ map__search( M0, Var, SelectorSet1 )
+ ->
+ proc_info_vartypes( ProcInfo, VarTypes ),
+ map__lookup( VarTypes, Var, VarType ),
+ alias_set2_least_upper_bound(
+ ModuleInfo, VarType,
+ SelectorSet0, SelectorSet1,
+ SelectorSet),
+ map__det_update( M0, Var, SelectorSet, M)
+ ;
+ map_det_insert( M0, Var, SelectorSet0, M,
+ "(pa_alias_set) least_upper_bound2/5" )
+ )
+ ),
+ Vars,
+ Map1,
+ Map),
+ pa_alias_set__recount( alias_set(0, Map), AliasSet ).
+
+least_upper_bound_list( ModuleInfo, ProcInfo, List, AliasSet):-
+ list__foldl(
+ least_upper_bound( ModuleInfo, ProcInfo),
+ List,
+ pa_alias_set__init,
+ AliasSet ).
+
+extend( ModuleInfo, ProcInfo, NewAliasSet, OldAliasSet, AliasSet):-
+
+ % first find the New-Old aliases resulting in an
+ % aliasSet containing only the directional New-Old (stored
+ % as Old-New) aliasSet, and the full resulting aliasSet.
+ altclos_two( ModuleInfo, ProcInfo, NewAliasSet, OldAliasSet,
+ OldNewAliasSet, FullOldNewAliasSet ),
+
+ % With the OldNewAliasSet, compute the NewOldNewAliasSet
+ % in the same-way.
+ altclos_two( ModuleInfo, ProcInfo, OldNewAliasSet, NewAliasSet,
+ _, FullNewOldNewAliasSet ),
+
+ list__foldl(
+ pa_alias_set__add,
+ [ NewAliasSet, FullOldNewAliasSet,
+ FullNewOldNewAliasSet ],
+ OldAliasSet,
+ AliasSet ).
+
+:- pred altclos_two( module_info::in, proc_info::in, alias_set::in,
+ alias_set::in, alias_set::out, alias_set::out) is det.
+altclos_two( ModuleInfo, ProcInfo, NewAliasSet, OldAliasSet,
+ PartialAliasSet, FullResult) :-
+ proc_info_vartypes( ProcInfo, VarTypes ),
+ NewAliasSet = alias_set( _, NewMap ),
+ OldAliasSet = alias_set( _, OldMap ),
+ % compute the common variables
+ map__keys( NewMap, NewVars ),
+ map__keys( OldMap, OldVars ),
+ set__list_to_set( NewVars, NewVarsSet ),
+ set__list_to_set( OldVars, OldVarsSet ),
+ set__intersect( NewVarsSet, OldVarsSet, CommonVarsSet),
+ set__to_sorted_list( CommonVarsSet, CommonVars ),
+ % for each common var, compute the aliases it generates
+ list__foldl2(
+ pred( Var::in, PM0::in, PM::out, FM0::in, FM::out ) is det:-
+ (
+ map__lookup( VarTypes, Var, Type ),
+ map__lookup( NewMap, Var, NewSelectorSet),
+ map__lookup( OldMap, Var, OldSelectorSet),
+ alias_set2_altclos( ModuleInfo, ProcInfo,
+ Type, NewSelectorSet, OldSelectorSet,
+ DirectedAliases ),
+ % Directed = FromOld to ToNew
+ pa_alias_set__new_directed_entries( DirectedAliases,
+ PM0, PM ),
+ pa_alias_set__new_entries( DirectedAliases,
+ FM0, FM )
+ ),
+ CommonVars,
+ pa_alias_set__init,
+ PartialAliasSet,
+ pa_alias_set__init,
+ FullResult ).
+
+ % alias_set2_altclos( ModuleInfo, ProcInfo, Type,
+ % NewSelectorSet, OldSelectorSet,
+ % OldNewDirectedAliases ).
+:- pred alias_set2_altclos( module_info::in, proc_info::in, (type)::in,
+ alias_set2::in, alias_set2::in,
+ list(alias)::out) is det.
+alias_set2_altclos( ModuleInfo, ProcInfo, Type,
+ NewSelectorSet, OldSelectorSet,
+ DirectedAliases ) :-
+ NewSelectorSet = alias_sel_set( _, NewMap ),
+ OldSelectorSet = alias_sel_set( _, OldMap ),
+ % get the selectors
+ map__keys( NewMap, NewSelectors),
+ map__keys( OldMap, OldSelectors),
+ list__foldl(
+ pred( NewSel::in, L0::in, L::out) is det:-
+ list__foldl(
+ altclos_basic( ModuleInfo, ProcInfo, Type,
+ NewMap, OldMap,
+ NewSel ),
+ OldSelectors,
+ L0,
+ L ),
+ NewSelectors,
+ [],
+ DirectedAliases ).
+
+
+:- pred altclos_basic( module_info::in, proc_info::in, (type)::in,
+ map(selector, data_set)::in,
+ map(selector, data_set)::in,
+ selector::in, selector::in,
+ list(alias)::in, list(alias)::out) is det.
+altclos_basic( ModuleInfo, _ProcInfo, Type, NewMap, OldMap,
+ NewSel, OldSel,
+ AccList, List ) :-
+ map__lookup( NewMap, NewSel, NewDataSet0),
+ map__lookup( OldMap, OldSel, OldDataSet0),
+ (
+ % NewSel = OldSel.Extension
+ pa_selector__less_or_equal( ModuleInfo, NewSel, OldSel,
+ Type, Extension )
+ ->
+ data_set_termshift( OldDataSet0, Extension, OldDataSet),
+ data_set_generate_directed_aliases( OldDataSet, NewDataSet0,
+ NewDirectedAliases )
+ ;
+ % NewSel.Extension = OldSel
+ pa_selector__less_or_equal( ModuleInfo, OldSel, NewSel,
+ Type, Extension)
+ ->
+ data_set_termshift( NewDataSet0, Extension, NewDataSet),
+ data_set_generate_directed_aliases( OldDataSet0, NewDataSet,
+ NewDirectedAliases )
+ ;
+ NewDirectedAliases = []
+ ),
+ List = append(NewDirectedAliases, AccList).
+
+
+add( AliasSet0, AliasSet1, AliasSet):-
+ AliasSet0 = alias_set(_, Map0 ),
+ AliasSet1 = alias_set(_, Map1 ),
+
+ map__foldl(
+ pred(Var::in, SelectorSet0::in, M0::in, M::out) is det:-
+ (
+ map__search( M0, Var, SelectorSet1 )
+ ->
+ alias_set2_add( SelectorSet1, SelectorSet0,
+ SelectorSet),
+ map__det_update( M0, Var, SelectorSet, M )
+ ;
+ map_det_insert( M0, Var, SelectorSet0, M,
+ "(pa_alias_set) add/3" )
+ ),
+ Map0,
+ Map1,
+ Map ),
+ pa_alias_set__recount( alias_set(0,Map), AliasSet).
+
+normalize( ModuleInfo, ProcInfo, AliasSet0, AliasSet) :-
+ proc_info_vartypes( ProcInfo, VarTypes),
+ AliasSet0 = alias_set( _, Map0 ),
+ map__keys( Map0, Vars ),
+ list__foldl(
+ pred( Var::in, M0::in, M::out) is det :-
+ (
+ map__lookup( Map0, Var, SelectorSet0 ),
+ map__lookup( VarTypes, Var, VarType),
+ alias_set2_normalize( ModuleInfo, ProcInfo, VarType,
+ SelectorSet0, SelectorSet),
+ map_det_insert( M0, Var, SelectorSet, M,
+ "(pa_alias_set) normalize/4" )
+ ),
+ Vars,
+ map__init,
+ Map ),
+ pa_alias_set__recount( alias_set(0, Map), AliasSet ).
+
+less_or_equal( ModuleInfo, ProcInfo, AliasSet1, AliasSet2 ):-
+ AliasSet1 = alias_set( _, Map1 ),
+ AliasSet2 = alias_set( _, Map2 ),
+ % check whether the variable-sets are identical
+ set__equal( set__list_to_set( map__keys( Map1 ) ),
+ set__list_to_set( map__keys( Map2 ) ) ),
+ % compute the least_upper_bound of both alias_sets
+ least_upper_bound( ModuleInfo, ProcInfo, AliasSet1, AliasSet2,
+ AliasSetLUB ),
+ % the result should then be equal to the original
+ % aliasSet (AliasSet2)
+ equal( AliasSet2, AliasSetLUB ).
+
+remove_vars( Vars, AliasSet0, AliasSet ):-
+ AliasSet0 = alias_set( _, Map0 ),
+ map__delete_list( Map0, Vars, Map1 ),
+ alias_set_map_values(
+ alias_set2_remove_vars(Vars),
+ alias_set(0, Map1),
+ AliasSet1),
+ recount( AliasSet1, AliasSet).
+
+
+print( PredInfo, ProcInfo, AliasSet, StartingString, EndString) -->
+ { pa_alias_set__to_pair_alias_list( AliasSet, AliasList ) },
+ io__write_list( AliasList, ",",
+ pa_alias__print(ProcInfo, PredInfo, StartingString,
+ EndString ) ).
+
+
+:- pred alias_set_fold( pred( alias_set2, alias_set2),
+ alias_set, alias_set).
+:- mode alias_set_fold( pred( in, in) is det, in, out) is det.
+
+alias_set_fold(_Pred, AliasSet, AliasSet).
+ % XXXXXXXXXX
+
+:- pred alias_set_map_values( pred( alias_set2, alias_set2),
+ alias_set, alias_set).
+:- mode alias_set_map_values( pred( in, out) is det, in, out ) is det.
+alias_set_map_values( Pred, AliasSet0, AliasSet) :-
+ AliasSet0 = alias_set( Size, Map0 ),
+ map__map_values(
+ pred( _K::in, S0::in, S::out) is det:-
+ (
+ Pred(S0, S)
+ ),
+ Map0,
+ Map),
+ AliasSet = alias_set( Size, Map ).
+
+
+
+
+% internal predicates:
+
+% alias_set2 = structure to keep track of mappings from selectors unto
+% concrete datastructures.
+
+:- pred alias_set2_empty( alias_set2 ).
+:- mode alias_set2_empty( out ) is det.
+:- mode alias_set2_empty( in ) is semidet.
+:- pred alias_set2_new_entry( selector::in, datastruct::in,
+ alias_set2::in, bool::out, alias_set2::out) is det.
+:- pred alias_set2_new_entry( selector::in, datastruct::in,
+ alias_set2::in, alias_set2::out) is det.
+:- pred alias_set2_get_size( alias_set2::in, int::out) is det.
+:- pred alias_set2_unfold( alias_set2::in,
+ list(pair(selector, datastruct) )::out) is det.
+:- pred alias_set2_project( list(prog_var)::in, alias_set2::in,
+ alias_set2::out ) is det.
+:- pred alias_set2_rename( map(prog_var, prog_var)::in,
+ alias_set2::in, alias_set2::out) is det.
+:- pred alias_set2_rename_types( term__substitution(tvar_type)::in,
+ alias_set2::in, alias_set2::out) is det.
+:- pred alias_set2_equal( alias_set2::in, alias_set2::in) is semidet.
+:- pred alias_set2_add( alias_set2::in, alias_set2::in,
+ alias_set2::out) is det.
+:- pred alias_set2_collect_aliases( module_info::in, (type)::in,
+ selector::in, alias_set2::in,
+ list(datastruct)::out ) is det.
+:- pred alias_set2_least_upper_bound( module_info::in, (type)::in,
+ alias_set2::in, alias_set2::in,
+ alias_set2::out ) is det.
+:- pred alias_set2_normalize( module_info::in, proc_info::in, (type)::in,
+ alias_set2::in, alias_set2::out) is det.
+:- pred alias_set2_remove_vars( list(prog_var)::in, alias_set2::in,
+ alias_set2::out) is det.
+
+alias_set2_empty( alias_sel_set( 0, map__init ) ).
+
+alias_set2_new_entry( Selector, Datastruct, AliasSet0, Added, AliasSet ):-
+ AliasSet0 = alias_sel_set( Size0, Map0 ),
+ (
+ map__search( Map0, Selector, DataSet0 )
+ ->
+ data_set_new_entry( Datastruct, DataSet0, Addition, DataSet),
+ (
+ Addition = yes,
+ Size = Size0 + 1,
+ Added = yes
+ ;
+ Addition = no,
+ Size = Size0,
+ Added = no
+ ),
+ map__det_update( Map0, Selector, DataSet, Map)
+ ;
+ data_set_empty( EmptyDataSet ),
+ data_set_new_entry( Datastruct, EmptyDataSet, DataSet),
+ Size = Size0 + 1,
+ Added = yes,
+ map_det_insert( Map0, Selector, DataSet, Map,
+ "(pa_alias_set) alias_set2_new_entry/5" )
+ ),
+ AliasSet = alias_sel_set( Size, Map).
+
+alias_set2_new_entry( Selector, Datastruct, AliasSet0, AliasSet ):-
+ alias_set2_new_entry( Selector, Datastruct, AliasSet0, _, AliasSet).
+
+alias_set2_get_size( alias_sel_set( Size, _ ), Size ).
+alias_set2_unfold( AliasSet, List ):-
+ AliasSet = alias_sel_set( _, Map ),
+ map__to_assoc_list( Map, Pairs ),
+ list__foldl(
+ pred( Pair::in, L0::in, L::out ) is det:-
+ (
+ Pair = Selector - DataSet,
+ data_set_get_datastructs( DataSet, Datastructs),
+ list__map(
+ pred( Datastruct::in, P::out ) is det :-
+ (
+ P = Selector - Datastruct
+ ),
+ Datastructs,
+ SelectorDatastructs),
+ list__append( SelectorDatastructs, L0, L )
+ ),
+ Pairs,
+ [],
+ List ).
+
+alias_set2_project( Vars, AliasSet0, AliasSet ):-
+ AliasSet0 = alias_sel_set(_, Map0 ),
+ map__foldl(
+ pred( Sel0::in, DataSet0::in, M0::in, M::out) is det:-
+ (
+ data_set_project( Vars, DataSet0, DataSet),
+ (
+ data_set_empty( DataSet )
+ ->
+ M0 = M
+ ;
+ map_det_insert( M0, Sel0, DataSet, M,
+ "(pa_alias_set) alias_set2_project/3" )
+ )
+ ),
+ Map0,
+ map__init,
+ Map),
+ alias_set2_recount( alias_sel_set(0, Map), AliasSet).
+
+:- pred alias_set2_recount( alias_set2::in, alias_set2::out) is det.
+alias_set2_recount( AliasSet0, AliasSet ):-
+ AliasSet0 = alias_sel_set( _, Map ),
+ map__foldl(
+ pred( _K::in, DataSet::in,
+ Counter0::in, Counter::out) is det :-
+ (
+ data_set_get_size( DataSet, S ),
+ Counter = Counter0 + S
+ ),
+ Map,
+ 0,
+ Size),
+ AliasSet = alias_sel_set( Size, Map ).
+
+alias_set2_rename( Dict, AliasSet0, AliasSet ):-
+ alias_set2_map_values( data_set_rename( Dict), AliasSet0, AliasSet).
+
+alias_set2_rename_types( Subst, AliasSet0, AliasSet ):-
+ AliasSet0 = alias_sel_set( Size, Map0 ),
+ map__to_assoc_list( Map0, AssocList0 ),
+ list__foldl(
+ pred( Pair::in, M0::in, M::out) is det :-
+ (
+ Pair = Sel0 - DataSet0,
+ pa_selector__rename_types( Subst, Sel0, Sel),
+ data_set_rename_types( Subst, DataSet0, DataSet),
+ map__det_insert( M0, Sel, DataSet, M )
+ ),
+ AssocList0,
+ map__init,
+ Map),
+ AliasSet = alias_sel_set( Size, Map).
+
+alias_set2_equal( AliasSet0, AliasSet1 ):-
+ AliasSet0 = alias_sel_set( Size, Map0 ),
+ AliasSet1 = alias_sel_set( Size, Map ),
+ map__keys( Map0, Keys0 ),
+ map__values( Map0, Values0 ),
+ alias_set2_equal2( Keys0, Values0, Map).
+
+:- pred alias_set2_equal2( list(selector)::in, list(data_set)::in,
+ map(selector, data_set)::in) is semidet.
+alias_set2_equal2( [], [], Map) :- map__is_empty( Map ).
+alias_set2_equal2( [ Sel0 | Sels ], [ DataSet0 | DataSets ], Map0 ):-
+ map__remove( Map0, Sel0, DataSet1, Map ),
+ data_set_equal( DataSet0, DataSet1 ),
+ alias_set2_equal2( Sels, DataSets, Map ).
+
+alias_set2_add( AliasSet0, AliasSet1, AliasSet ):-
+ AliasSet0 = alias_sel_set( _, Map0 ),
+ AliasSet1 = alias_sel_set( _, Map1 ),
+ map__to_assoc_list( Map0, Pairs),
+ list__foldl(
+ pred( Pair::in, M0::in, M::out) is det :-
+ (
+ Pair = Sel - DataSet0,
+ (
+ map__search( M0, Sel, DataSet1 )
+ ->
+ data_set_add( DataSet0, DataSet1, DataSet),
+ map__det_update( M0, Sel, DataSet, M)
+ ;
+ map__det_insert( M0, Sel, DataSet0, M)
+ )
+ ),
+ Pairs,
+ Map1,
+ Map),
+ alias_set2_recount( alias_sel_set(0, Map), AliasSet ).
+
+:- pred alias_set2_map_values( pred(data_set, data_set),
+ alias_set2, alias_set2).
+:- mode alias_set2_map_values( pred(in, out) is det, in, out) is det.
+alias_set2_map_values( Pred, AliasSet0, AliasSet ):-
+ AliasSet0 = alias_sel_set( Size, Map0),
+ map__map_values(
+ pred( _K::in, D0::in, D::out) is det :-
+ ( Pred( D0, D) ), Map0, Map),
+ AliasSet = alias_sel_set( Size, Map).
+
+alias_set2_collect_aliases( ModuleInfo, Type,
+ Selector, SelectorSet, Datastructs):-
+ SelectorSet = alias_sel_set( _Size, Map),
+ map__keys( Map, Selectors ),
+ list__foldl(
+ pred( Sel::in, Data0::in, Data::out) is det:-
+ (
+ % if Sel is more general than Selector, i.e.
+ % Selector = Sel.Extension, apply this extension
+ % to all the datastructs associated with that Sel.
+ (
+ less_or_equal( ModuleInfo, Selector,
+ Sel, Type, Extension )
+ ->
+ map__lookup( Map, Sel, DataSet0 ),
+ data_set_termshift( DataSet0, Extension,
+ DataSet),
+ data_set_add( Data0, DataSet, Data)
+ ;
+ Data = Data0
+ )
+ ),
+ Selectors,
+ data_set_empty,
+ CollectedDataSet ),
+ data_set_get_datastructs( CollectedDataSet, Datastructs).
+
+alias_set2_least_upper_bound( ModuleInfo, Type,
+ SelectorSet0, SelectorSet1, SelectorSet):-
+ SelectorSet0 = alias_sel_set( _Size0, Map0 ),
+ SelectorSet1 = alias_sel_set( _Size1, Map1 ),
+ map__to_assoc_list( Map0, Assoc0 ),
+ list__foldl(
+ alias_set2_lub( ModuleInfo, Type ),
+ Assoc0,
+ Map1,
+ Map),
+ alias_set2_add( alias_sel_set(0,Map), SelectorSet0, SelectorSet).
+
+ % alias_set2_lub( ModuleInfo, Type, Pair, Map0, Map):-
+ % Least upper bound between a real selectorset (Map0), and one
+ % single entry of another selectorset (Pair).
+ % precondition: the first selectorset is minimal (i.e., does
+ % not contain superfluous entries, e.g. Hv1/[] - Hv2/[] and
+ % in the same time Hv1/el - Hv2/el .
+:- pred alias_set2_lub( module_info::in, (type)::in,
+ pair(selector,data_set)::in,
+ map(selector, data_set)::in,
+ map(selector, data_set)::out ) is det.
+alias_set2_lub( ModuleInfo, Type, Pair0, M0, M):-
+ map__keys( M0, Selectors ),
+ Pair0 = Sel0 - DataSet0,
+ list__foldl2(
+ alias_set2_lub2( ModuleInfo, Type, Sel0 ),
+ Selectors,
+ DataSet0,
+ DataSet,
+ M0,
+ M1),
+ % and finally, add what is remaining of DataSet
+ (
+ data_set_empty(DataSet)
+ ->
+ M = M1
+ ;
+ (
+ map__search( M1, Sel0, DataSetA)
+ ->
+ data_set_add( DataSetA, DataSet, DataSetNew),
+ map__det_update( M1, Sel0, DataSetNew, M)
+ ;
+ map__det_insert( M1, Sel0, DataSet0, M)
+ )
+ ).
+
+ % alias_set2_lub2( ModuleInfo, Type, FirstSel0, OtherSel,
+ % FirstDataSet0, FirstDataSet,
+ % OtherMap0, OtherMap ).
+ % OtherSel is a selector from OtherMap0. FirstDataSet0 corresponds
+ % with FirstSel0, and comes from a first SelectorSet.
+:- pred alias_set2_lub2( module_info::in, (type)::in,
+ selector::in, selector::in,
+ data_set::in, data_set::out,
+ map(selector, data_set)::in,
+ map(selector, data_set)::out ) is det.
+alias_set2_lub2( ModuleInfo, Type, FirstSel0, OtherSel,
+ FirstDataSet0, FirstDataSet,
+ OtherMap0, OtherMap ):-
+ (
+ data_set_empty( FirstDataSet0 )
+ ->
+ FirstDataSet = FirstDataSet0,
+ OtherMap = OtherMap0
+ ;
+ (
+ % FirstSel0 = OtherSel.Extension
+ pa_selector__less_or_equal( ModuleInfo,
+ FirstSel0, OtherSel, Type, Extension)
+ ->
+ map__lookup( OtherMap0, OtherSel, OtherDataSet0 ),
+ data_set_termshift( OtherDataSet0, Extension,
+ OtherDataSetOTS ),
+ % remove the OtherDataSetOTS entries from
+ % FirstDataSet0
+ data_set_difference( FirstDataSet0, OtherDataSetOTS,
+ FirstDataSet ),
+ OtherMap = OtherMap0
+ ;
+ pa_selector__less_or_equal( ModuleInfo,
+ OtherSel, FirstSel0, Type, Extension)
+ ->
+ map__lookup( OtherMap0, OtherSel, OtherDataSet0 ),
+ data_set_termshift( FirstDataSet0, Extension,
+ FirstDataSet0TS ),
+ data_set_difference( OtherDataSet0,
+ FirstDataSet0TS,
+ OtherDataSet ),
+ map__det_update( OtherMap0, OtherSel, OtherDataSet,
+ OtherMap ),
+ FirstDataSet = FirstDataSet0
+ ;
+ FirstDataSet = FirstDataSet0,
+ OtherMap = OtherMap0
+ )
+ ).
+
+
+alias_set2_normalize( ModuleInfo, ProcInfo, Type, SelectorSet0,
+ SelectorSet ):-
+ SelectorSet0 = alias_sel_set( _, Map0 ),
+ map__keys( Map0, Selectors),
+ list__foldl(
+ pred( Sel0::in, M0::in, M::out) is det:-
+ (
+ pa_selector__normalize_wti( Type, ModuleInfo,
+ Sel0, Sel0Norm ),
+ map__lookup( Map0, Sel0, DataSet0 ),
+ data_set_normalize( ModuleInfo, ProcInfo,
+ DataSet0, DataSet1 ),
+ (
+ map__search( M0, Sel0Norm, DataSetM )
+ ->
+ data_set_add( DataSetM, DataSet1, DataSet ),
+ map__det_update( M0, Sel0Norm, DataSet, M)
+ ;
+ map__det_insert( M0, Sel0Norm, DataSet1, M)
+ )
+ ),
+ Selectors,
+ map__init,
+ Map),
+ alias_set2_recount( alias_sel_set( 0, Map), SelectorSet ).
+
+
+alias_set2_remove_vars( Vars, SelectorSet0, SelectorSet ):-
+ SelectorSet0 = alias_sel_set( _, Map0 ),
+ map__keys( Map0, Selectors0 ),
+ list__foldl(
+ pred( Sel0::in, M0::in, M::out) is det :-
+ (
+ map__lookup( Map0, Sel0, DataSet0 ),
+ data_set_remove_vars( Vars, DataSet0, DataSet ),
+ (
+ data_set_empty( DataSet )
+ ->
+ M = M0
+ ;
+ map__det_insert( M0, Sel0, DataSet, M )
+ )
+ ),
+ Selectors0,
+ map__init,
+ Map ),
+ alias_set2_recount( alias_sel_set( 0, Map), SelectorSet).
+
+
+% data_set
+
+:- pred data_set_empty( data_set ).
+:- func data_set_empty = data_set.
+:- mode data_set_empty( out ) is det.
+:- mode data_set_empty( in ) is semidet.
+
+:- pred data_set_new_entry( datastruct::in, data_set::in,
+ bool::out, data_set::out ) is det.
+:- pred data_set_new_entry( datastruct::in, data_set::in, data_set::out) is det.
+:- pred data_set_member( datastruct::in, data_set::in) is semidet.
+:- pred data_set_get_size( data_set::in, int::out) is det.
+:- pred data_set_get_datastructs( data_set::in, list(datastruct)::out) is det.
+:- pred data_set_project( list(prog_var)::in,
+ data_set::in, data_set::out) is det.
+:- pred data_set_rename( map(prog_var, prog_var)::in,
+ data_set::in, data_set::out) is det.
+:- pred data_set_rename_types( term__substitution(tvar_type)::in,
+ data_set::in, data_set::out) is det.
+:- pred data_set_equal( data_set::in, data_set::in ) is semidet.
+:- pred data_set_add( data_set::in, data_set::in, data_set::out) is det.
+:- pred data_set_termshift( data_set::in, selector::in, data_set::out) is det.
+:- pred data_set_normalize( module_info::in, proc_info::in,
+ data_set::in, data_set::out) is det.
+:- pred data_set_generate_directed_aliases( data_set::in,
+ data_set::in, list(alias)::out) is det.
+:- pred data_set_remove_vars( list(prog_var)::in, data_set::in,
+ data_set::out) is det.
+ % data_set_difference( A, B, C ):- C = A - B.
+:- pred data_set_difference( data_set::in, data_set::in,
+ data_set::out) is det.
+
+data_set_empty( datastructs(0, set__init ) ).
+data_set_empty = D :- data_set_empty(D).
+data_set_new_entry( Data, DataSet0, NewAddition, DataSet ):-
+ DataSet0 = datastructs( Size0, Datastructs0 ),
+ (
+ set__member( Data, Datastructs0 )
+ ->
+ NewAddition = bool__no,
+ DataSet = DataSet0
+ ;
+ set__insert(Datastructs0, Data, Datastructs),
+ Size = Size0 + 1,
+ NewAddition = bool__yes,
+ DataSet = datastructs( Size, Datastructs )
+ ).
+data_set_new_entry( Data, DataSet0, DataSet) :-
+ data_set_new_entry( Data, DataSet0, _, DataSet).
+data_set_member( Data, DataSet ) :-
+ DataSet = datastructs( N, DataStructs),
+ N \= 0,
+ set__member( Data, DataStructs ).
+data_set_get_size( DataSet, Size ):-
+ DataSet = datastructs( Size, _ ).
+data_set_get_datastructs( DataSet, ListDatastructs ):-
+ DataSet = datastructs( _, SetDatastructs),
+ set__to_sorted_list( SetDatastructs, ListDatastructs).
+data_set_project( Vars, DataSet0, DataSet ):-
+ data_set_filter(
+ pred( Data::in ) is semidet :-
+ (
+ get_var(Data, Var),
+ list__member( Var, Vars )
+ ),
+ DataSet0,
+ DataSet ).
+data_set_rename( Dict, DataSet0, DataSet) :-
+ data_set_map( pa_datastruct__rename( Dict ), DataSet0, DataSet).
+data_set_rename_types( Subst, DataSet0, DataSet ):-
+ data_set_map( pa_datastruct__rename_types( Subst ),
+ DataSet0, DataSet ).
+data_set_equal( DataSet0, DataSet1 ):-
+ DataSet0 = datastructs( Size0, Data0 ),
+ DataSet1 = datastructs( Size0, Data1 ),
+ set__to_sorted_list(Data0, LData0),
+ set__to_sorted_list(Data1, LData1),
+ list__foldl(
+ ho_delete( pa_datastruct__equal),
+ LData0,
+ LData1,
+ [] ).
+
+ % ho_delete( EqualityTest, Elem, List0, List): delete element Elem
+ % from the given list (List0) using the EqualityTest.
+:- pred ho_delete( pred(T, T), T, list(T), list(T)).
+:- mode ho_delete( pred( in, in) is semidet, in, in, out) is semidet.
+ho_delete( Equal, Elem, List0, List) :-
+ List0 = [ H | T ],
+ (
+ Equal( Elem, H )
+ ->
+ List = T
+ ;
+ ho_delete( Equal, Elem, T, Rest ),
+ List = [ H | Rest ]
+ ).
+
+data_set_add( DataSet0, DataSet1, DataSet) :-
+ DataSet0 = datastructs( _Size0, Data0 ),
+ DataSet1 = datastructs( _Size1, Data1 ),
+ Data = set__union( Data0, Data1 ),
+ DataSet = datastructs( set__count(Data), Data ).
+
+data_set_termshift( DataSet0, Sel, DataSet ):-
+ data_set_map(
+ pred( D0::in, D::out) is det :-
+ (
+ pa_datastruct__termshift( D0, Sel, D)
+ ),
+ DataSet0,
+ DataSet ).
+
+ % higher order predicates for handling data_set's.
+:- pred data_set_map( pred( datastruct, datastruct), data_set, data_set).
+:- mode data_set_map( pred(in, out) is det, in, out) is det.
+data_set_map( Pred, DataSet0, DataSet ):-
+ DataSet0 = datastructs( _Size, Datastructs0 ),
+ Datastructs = set__map( tofunc(Pred), Datastructs0),
+ DataSet = datastructs( set__count(Datastructs), Datastructs ).
+
+:- func tofunc( pred(X,Y), X ) = Y.
+:- mode tofunc( pred(in,out) is det, in) = out is det.
+
+tofunc( Pred, X ) = Y :- Pred(X, Y).
+
+:- pred data_set_filter( pred(datastruct), data_set, data_set).
+:- mode data_set_filter( pred(in) is semidet, in, out) is det.
+data_set_filter( Pred, DataSet0, DataSet):-
+ DataSet0 = datastructs( _, Datastructs0),
+ Datastructs = set__filter( Pred, Datastructs0),
+ DataSet = datastructs( set__count(Datastructs), Datastructs).
+
+data_set_normalize( ModuleInfo, ProcInfo, DataSet0, DataSet ):-
+ data_set_map(
+ pa_datastruct__normalize_wti( ProcInfo, ModuleInfo ),
+ DataSet0,
+ DataSet ).
+
+data_set_generate_directed_aliases( FromDataSet, ToDataSet, Aliases):-
+ FromDataSet = datastructs( _, FromData),
+ ToDataSet = datastructs( _, ToData ),
+ set_cross_product( FromData, ToData, AliasesSet),
+ set__to_sorted_list( AliasesSet, Aliases ).
+
+data_set_remove_vars( Vars, DataSet0, DataSet ):-
+ data_set_filter(
+ pred( DataStruct::in ) is semidet :-
+ (
+ get_var( DataStruct, Var ),
+ \+ list__member( Var, Vars )
+ ),
+ DataSet0,
+ DataSet ).
+
+data_set_difference( DataSet1, DataSet2, DataSet ):-
+ DataSet1 = datastructs( _, Data1),
+ DataSet2 = datastructs( _, Data2),
+ Data = set__difference( Data1, Data2 ),
+ DataSet = datastructs( set__count( Data ), Data ).
+
+
+:- pred set_cross_product( set(T1)::in, set(T2)::in,
+ set(pair(T1, T2))::out) is det.
+
+set_cross_product( Set0, Set1, CrossProduct ):-
+ solutions_set(
+ pred( Pair::out ) is nondet :-
+ (
+ set__member( Elem0, Set0 ),
+ set__member( Elem1, Set1 ),
+ Pair = Elem0 - Elem1
+ ),
+ CrossProduct).
+
+%-----------------------------------------------------------------------------%
+
+:- import_module require, string.
+:- pred map_det_insert( map(K,V)::in, K::in, V::in,
+ map(K,V)::out, string::in) is det.
+map_det_insert( Map0, K, V, Map, Msg ) :-
+ (
+ map__insert( Map0, K, V, Map1 )
+ ->
+ Map = Map1
+ ;
+ string__append_list([ Msg, ": map_det_insert-problem"], Msg2),
+ require__error( Msg2 )
+ ).
Index: pa_datastruct.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/pa_datastruct.m,v
retrieving revision 1.1.2.3
diff -u -r1.1.2.3 pa_datastruct.m
--- pa_datastruct.m 2001/02/13 14:31:21 1.1.2.3
+++ pa_datastruct.m 2001/03/05 16:52:03
@@ -222,14 +222,8 @@
normalize_wti_2( VarTypes, HLDS, D0, D ):-
D0 = cel( ProgVar, SEL0 ),
map__lookup(VarTypes, ProgVar, VarType),
- (
- type_util__is_introduced_type_info_type(VarType)
- ->
- D = D0
- ;
- pa_selector__normalize_wti( VarType, HLDS, SEL0, SEL),
- D = cel( ProgVar, SEL )
- ).
+ pa_selector__normalize_wti( VarType, HLDS, SEL0, SEL),
+ D = cel( ProgVar, SEL ).
apply_widening( ModuleInfo, ProcInfo, D0, D ):-
D0 = cel( ProgVar, Sel0 ),
Index: pa_run.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/pa_run.m,v
retrieving revision 1.1.2.15
diff -u -r1.1.2.15 pa_run.m
--- pa_run.m 2001/03/05 12:06:07 1.1.2.15
+++ pa_run.m 2001/03/05 16:52:04
@@ -261,6 +261,9 @@
},
io__write_strings(["\t\t: ", FullS, "/", ProjectS, "/",
NormS, "\n"])
+
+% pa_alias_as__print_aliases(Alias, ProcInfo, PredInfo),
+% io__write_string("\n")
/**
io__write_strings(["\t\t: ", FullS, "/", ProjectS, "/",
NormS, "\n"]),
Index: pa_selector.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/pa_selector.m,v
retrieving revision 1.1.2.3
diff -u -r1.1.2.3 pa_selector.m
--- pa_selector.m 2001/02/13 14:31:22 1.1.2.3
+++ pa_selector.m 2001/03/05 16:52:04
@@ -67,14 +67,6 @@
:- pred termshift(selector, selector, selector).
:- mode termshift(in, in, out) is det.
- % less_or_equal(S1, S2, EXT).
- % Predicate holds when S1 is less than or equal to S2 ("is
- % subsumed by"), i.e. S1 can be selected by extending S2 with
- % the extension EXT (output).
- % PRECONDITION: the selectors do not contain any type-selectors.
-:- pred less_or_equal(selector, selector, selector).
-:- mode less_or_equal(in, in, out) is semidet.
-
% 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
@@ -133,6 +125,14 @@
termshift(S0,[US],S).
termshift(S1,S2,S):- list__append(S1,S2,S).
+ % less_or_equal(S1, S2, EXT).
+ % Predicate holds when S1 is less than or equal to S2 ("is
+ % subsumed by"), i.e. S1 can be selected by extending S2 with
+ % the extension EXT (output).
+ % PRECONDITION: the selectors do not contain any type-selectors.
+:- pred less_or_equal(selector, selector, selector).
+:- mode less_or_equal(in, in, out) is semidet.
+
less_or_equal( S1, S2, EXT ) :-
list__append(S2, EXT , S1).
@@ -247,10 +247,16 @@
normalize_wti( VarType, HLDS, SEL0, SEL ):-
- branch_map_init( B0 ),
- init( TOP ),
- branch_map_insert( VarType, TOP, B0, B1 ),
- normalize_wti_2( VarType, HLDS, B1, TOP, SEL0, SEL).
+ (
+ type_util__is_introduced_type_info_type(VarType)
+ ->
+ SEL = SEL0
+ ;
+ branch_map_init( B0 ),
+ init( TOP ),
+ branch_map_insert( VarType, TOP, B0, B1 ),
+ normalize_wti_2( VarType, HLDS, B1, TOP, SEL0, SEL)
+ ).
:- pred normalize_wti_2( type, module_info, branch_map,
selector, selector, selector).
@@ -267,9 +273,10 @@
% switch on the kind of selector, unit selector
% or type selector.
(
+ (
US = us(CONS, INDEX),
- type_util__get_cons_id_arg_types(HLDS,
- VarType, CONS, ArgTypes ),
+ type_util__get_cons_id_non_existential_arg_types(HLDS,
+ VarType, CONS, ArgTypes ),
(
list__index1(ArgTypes, INDEX, SubType )
->
@@ -278,22 +285,27 @@
error(index_error_message(HLDS,
VarType, CONS, INDEX))
)
- ;
+ ;
US = ts( CType )
- ),
- (
- branch_map_search( B0, CType,
- BSel )
+ )
->
- normalize_wti_2( CType, HLDS,
- B0, BSel, SELR, SEL )
+ (
+ branch_map_search( B0, CType,
+ BSel )
+ ->
+ normalize_wti_2( CType, HLDS,
+ B0, BSel, SELR, SEL )
+ ;
+ unit_termshift( Acc0, US,
+ Acc1 ),
+ branch_map_insert( CType,
+ Acc1, B0, B1 ),
+ normalize_wti_2( CType, HLDS,
+ B1, Acc1, SELR, SEL )
+ )
;
- unit_termshift( Acc0, US,
- Acc1 ),
- branch_map_insert( CType,
- Acc1, B0, B1 ),
- normalize_wti_2( CType, HLDS,
- B1, Acc1, SELR, SEL )
+ % existentially typed functor.
+ append( Acc0, SEL0, SEL)
)
;
% if it's not a user type, SELR will be empty
Index: pa_sr_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/pa_sr_util.m,v
retrieving revision 1.1.2.1
diff -u -r1.1.2.1 pa_sr_util.m
--- pa_sr_util.m 2001/02/07 10:19:09 1.1.2.1
+++ pa_sr_util.m 2001/03/05 16:52:04
@@ -69,9 +69,65 @@
->
S = S1
;
- require__error("(pa_alias_as) rename_type_det: types are not
-unifiable.")
+ S = S0
+/**
+ term_to_tmp_string( FromType, FromTypeString),
+ term_to_tmp_string( ToType, ToTypeString),
+ string__append_list( [
+ "(pa_sr_util) rename_type_det: types are not unifiable. \n",
+ "\tFromType = ", FromTypeString, "\n",
+ "\tToType = ", ToTypeString ], Msg ),
+ require__error(Msg)
+**/
).
+
+:- import_module string.
+:- pred term_to_tmp_string( term(T)::in, string::out) is det.
+
+term_to_tmp_string( functor( Const, Args, _Cxt ), String ):-
+ const_to_tmp_string( Const, S0 ),
+ list__map( term_to_tmp_string, Args, ArgStrings),
+ (
+ ArgStrings = []
+ ->
+ Arguments = ""
+ ;
+ to_comma_separated_list( ArgStrings, Args0),
+ string__append_list( ["(", Args0, ")" ], Arguments)
+ ),
+ string__append_list( [ S0, Arguments ], String).
+term_to_tmp_string( variable( _ ), "var").
+
+:- pred context_to_tmp_string( term__context::in, string::out) is det.
+context_to_tmp_string( context( File, LineNumber ), String ):-
+ string__int_to_string( LineNumber, Line),
+ string__append_list( [ File, ":", Line ], String).
+
+:- pred to_comma_separated_list( list(string)::in, string::out) is det.
+to_comma_separated_list( [], "").
+to_comma_separated_list( [ First | Rest ], String ):-
+ (
+ Rest = []
+ ->
+ String = First
+ ;
+ to_comma_separated_list( Rest, StringRest),
+ string__append_list( [First, ",", StringRest ], String)
+ ).
+
+:- pred const_to_tmp_string( const::in, string::out) is det.
+const_to_tmp_string( Const, String ):-
+ (
+ Const = atom(String)
+ ;
+ Const = integer(Int),
+ string__int_to_string(Int,String)
+ ;
+ Const = string(String)
+ ;
+ Const = float(Float),
+ string__float_to_string(Float, String)
+ ).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
--------------------------------------------------------------------------
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