[m-rev.] diff: more ctgc fixes and cleanups
Julien Fischer
juliensf at cs.mu.OZ.AU
Fri Mar 3 17:07:58 AEDT 2006
Estimated hours taken: 1.5
Branches: main
More fixes and cleanups for ctgc. The only algorithmic change is that
we now disable structure sharing for predicates from *all* builtin modules,
not just those from builtin and private_builtin.
compiler/structure_sharing.analysis.m:
compiler/structure_sharing.domain.m:
compiler/prog_ctgc.m:
compiler/ctgc.datastruct.m:
Further cleanups for the ctgc system.
Julien.
Index: compiler/ctgc.datastruct.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ctgc.datastruct.m,v
retrieving revision 1.3
diff -u -r1.3 ctgc.datastruct.m
--- compiler/ctgc.datastruct.m 1 Mar 2006 03:21:18 -0000 1.3
+++ compiler/ctgc.datastruct.m 3 Mar 2006 04:23:00 -0000
@@ -82,7 +82,9 @@
%-----------------------------------------------------------------------------%
datastruct_init(V) = datastruct_init_with_selector(V, []).
+
datastruct_init_with_selector(V, Sel) = selected_cel(V, Sel).
+
datastruct_init_with_pos(V, ConsId, Int)
= datastruct_init_with_selector(V, selector_init(ConsId, Int)).
Index: compiler/prog_ctgc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_ctgc.m,v
retrieving revision 1.3
diff -u -r1.3 prog_ctgc.m
--- compiler/prog_ctgc.m 1 Mar 2006 03:21:19 -0000 1.3
+++ compiler/prog_ctgc.m 3 Mar 2006 03:41:59 -0000
@@ -44,8 +44,10 @@
%
:- pred print_selector(tvarset::in, selector::in, io::di, io::uo) is det.
+
:- pred print_datastruct(prog_varset::in, tvarset::in, datastruct::in,
io::di, io::uo) is det.
+
:- pred print_structure_sharing_pair(prog_varset::in, tvarset::in,
structure_sharing_pair::in, io::di, io::uo) is det.
@@ -87,8 +89,8 @@
:- pred print_structure_sharing_domain(prog_varset::in, tvarset::in, bool::in,
maybe(int)::in, structure_sharing_domain::in, io::di, io::uo) is det.
- % Print the available structure sharing information as a
- % mercury-comment (used in the hlds-dump).
+ % Print the available structure sharing information as a Mercury comment.
+ % This is used in HLDS dumps.
%
:- pred dump_maybe_structure_sharing_domain(prog_varset::in, tvarset::in,
maybe(structure_sharing_domain)::in, io::di, io::uo) is det.
@@ -282,7 +284,7 @@
:- func selector_to_string(tvarset, selector) = string.
-selector_to_string(TVarSet, Selector) = String :-
+selector_to_string(TVarSet, Selector) = String :-
(
Selector = [],
String = "[]"
@@ -381,8 +383,7 @@
;
VerboseTop = yes,
io.write_string("top([", !IO),
- io.write_list(Msgs, Separator,
- io.write_string, !IO),
+ io.write_list(Msgs, Separator, io.write_string, !IO),
io.write_string("])", !IO)
)
;
@@ -421,8 +422,10 @@
prog_type_subst.apply_subst_to_type(Subst, Type0, Type),
!:UnitSelector = typesel(Type)
).
+
rename_selector(TypeSubst, !Selector) :-
list.map(rename_unit_selector(TypeSubst), !Selector).
+
rename_datastruct(Dict, Subst, !Data) :-
!.Data = selected_cel(Var0, Sel0),
map.lookup(Dict, Var0, Var),
@@ -430,6 +433,7 @@
!:Data = selected_cel(Var, Sel).
rename_datastruct(Dict, Subst, Data0) = Data :-
rename_datastruct(Dict, Subst, Data0, Data).
+
rename_structure_sharing_pair(Dict, TypeSubst, !Pair) :-
!.Pair = D1 - D2,
rename_datastruct(Dict, TypeSubst, D1, Da),
@@ -437,11 +441,11 @@
!:Pair = Da - Db.
rename_structure_sharing(Dict, TypeSubst, !List) :-
list.map(rename_structure_sharing_pair(Dict, TypeSubst), !List).
+
rename_structure_sharing_domain(_, _, bottom, bottom).
-rename_structure_sharing_domain(_, _, X at top(_), X).
-rename_structure_sharing_domain(Dict, TypeSubst,
- real(List0), real(List)):-
- rename_structure_sharing(Dict, TypeSubst, List0, List).
+rename_structure_sharing_domain(_, _, X @ top(_), X).
+rename_structure_sharing_domain(Dict, TypeSubst, real(!.List), real(!:List)):-
+ rename_structure_sharing(Dict, TypeSubst, !List).
%-----------------------------------------------------------------------------%
Index: compiler/structure_sharing.analysis.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/structure_sharing.analysis.m,v
retrieving revision 1.7
diff -u -r1.7 structure_sharing.analysis.m
--- compiler/structure_sharing.analysis.m 1 Mar 2006 03:21:19 -0000 1.7
+++ compiler/structure_sharing.analysis.m 3 Mar 2006 04:42:32 -0000
@@ -110,8 +110,9 @@
load_structure_sharing_table_2(ModuleInfo, PredId, !SharingTable) :-
module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ ProcIds = pred_info_procids(PredInfo),
list.foldl(load_structure_sharing_table_3(ModuleInfo, PredId),
- pred_info_procids(PredInfo), !SharingTable).
+ ProcIds, !SharingTable).
:- pred load_structure_sharing_table_3(module_info::in, pred_id::in,
proc_id::in, sharing_as_table::in, sharing_as_table::out) is det.
@@ -121,8 +122,9 @@
proc_info_get_structure_sharing(ProcInfo, MaybePublicSharing),
(
MaybePublicSharing = yes(PublicSharing),
- sharing_as_table_set(proc(PredId, ProcId),
- from_structure_sharing_domain(PublicSharing), !SharingTable)
+ PPId = proc(PredId, ProcId),
+ PrivateSharing = from_structure_sharing_domain(PublicSharing),
+ sharing_as_table_set(PPId, PrivateSharing, !SharingTable)
;
MaybePublicSharing = no
).
@@ -167,10 +169,10 @@
module_info::in, module_info::out) is det.
save_sharing_in_module_info(PPId, SharingAs, !ModuleInfo) :-
- module_info_pred_proc_info(!.ModuleInfo, PPId, PredInfo0, ProcInfo0),
+ module_info_pred_proc_info(!.ModuleInfo, PPId, PredInfo, ProcInfo0),
proc_info_set_structure_sharing(to_structure_sharing_domain(SharingAs),
ProcInfo0, ProcInfo),
- module_info_set_pred_proc_info(PPId, PredInfo0, ProcInfo, !ModuleInfo).
+ module_info_set_pred_proc_info(PPId, PredInfo, ProcInfo, !ModuleInfo).
:- pred analyse_scc(module_info::in, list(pred_proc_id)::in,
sharing_as_table::in, sharing_as_table::out, io::di, io::uo) is det.
@@ -216,57 +218,96 @@
!IO),
% Collect relevant procedure information.
+ %
module_info_pred_proc_info(ModuleInfo, PPId, PredInfo, ProcInfo),
- PPId = proc(PredId, ProcId),
proc_info_headvars(ProcInfo, HeadVars),
% Write progress message for the start of analysing current procedure.
+ %
Run = ss_fixpoint_table_which_run(!.FixpointTable),
TabledAsDescr = ss_fixpoint_table_get_short_description(PPId,
!.FixpointTable),
- passes_aux.write_proc_progress_message(
+ write_proc_progress_message(
"% Sharing analysis (run " ++ string.int_to_string(Run) ++ ") ",
- PredId, ProcId, ModuleInfo, !IO),
+ PPId, ModuleInfo, !IO),
% In some cases the sharing can be predicted to be bottom, in which
% case a full sharing analysis is not needed.
- Sharing0 = sharing_as_init,
- ( bottom_sharing_is_safe_approximation(ModuleInfo, ProcInfo) ->
- maybe_write_string(Verbose, "\t\t: bottom predicted", !IO),
- Sharing = Sharing0
- ;
- % Start analysis.
- proc_info_goal(ProcInfo, Goal),
- analyse_goal(ModuleInfo, PredInfo, ProcInfo, SharingTable, Goal,
- !FixpointTable, Sharing0, Sharing1, !IO),
- FullAsDescr = short_description(Sharing1),
-
- sharing_as_project(HeadVars, Sharing1, Sharing2),
- ProjAsDescr = short_description(Sharing2),
-
- structure_sharing.domain.apply_widening(ModuleInfo, ProcInfo,
- WideningLimit, WideningDone, Sharing2, Sharing3),
- (
- WideningDone = yes,
- WidenAsDescr = short_description(Sharing3)
+ %
+ some [!Sharing] (
+ !:Sharing = sharing_as_init,
+ ( bottom_sharing_is_safe_approximation(ModuleInfo, ProcInfo) ->
+ maybe_write_string(Verbose, "\t\t: bottom predicted", !IO)
;
- WideningDone = no,
- WidenAsDescr = "-"
+ % Start analysis.
+ proc_info_goal(ProcInfo, Goal),
+ analyse_goal(ModuleInfo, PredInfo, ProcInfo, SharingTable, Goal,
+ !FixpointTable, !Sharing, !IO),
+ FullAsDescr = short_description(!.Sharing),
+
+ sharing_as_project(HeadVars, !Sharing),
+ ProjAsDescr = short_description(!.Sharing),
+
+ domain.apply_widening(ModuleInfo, ProcInfo, WideningLimit,
+ WideningDone, !Sharing),
+ (
+ WideningDone = yes,
+ WidenAsDescr = short_description(!.Sharing)
+ ;
+ WideningDone = no,
+ WidenAsDescr = "-"
+ ),
+
+ maybe_write_string(Verbose, "\t\t: " ++
+ TabledAsDescr ++ "->" ++
+ FullAsDescr ++ "/" ++
+ ProjAsDescr ++ "/" ++
+ WidenAsDescr, !IO)
),
+ ss_fixpoint_table_new_as(ModuleInfo, ProcInfo, PPId, !.Sharing,
+ !FixpointTable)
+ ),
+ maybe_write_string(Verbose, "\t\t (ft = " ++
+ ss_fixpoint_table_description(!.FixpointTable) ++ ")\n", !IO).
- maybe_write_string(Verbose, "\t\t: " ++
- TabledAsDescr ++ "->" ++
- FullAsDescr ++ "/" ++
- ProjAsDescr ++ "/" ++
- WidenAsDescr, !IO),
+%-----------------------------------------------------------------------------%
+
+ % Succeeds if the sharing of a procedure can safely be approximated by
+ % "bottom", simply by looking at the modes and types of the arguments.
+ %
+:- pred bottom_sharing_is_safe_approximation(module_info::in,
+ proc_info::in) is semidet.
+
+bottom_sharing_is_safe_approximation(ModuleInfo, ProcInfo) :-
+ proc_info_headvars(ProcInfo, HeadVars),
+ proc_info_argmodes(ProcInfo, Modes),
+ proc_info_vartypes(ProcInfo, VarTypes),
+ list.map(map.lookup(VarTypes), HeadVars, Types),
+
+ ModeTypePairs = assoc_list.from_corresponding_lists(Modes, Types),
- Sharing = Sharing3
+ Test = (pred(Pair::in) is semidet :-
+ Pair = Mode - Type,
+
+ % mode is not unique nor clobbered.
+ mode_get_insts(ModuleInfo, Mode, _LeftInst, RightInst),
+ \+ inst_is_unique(ModuleInfo, RightInst),
+ \+ inst_is_clobbered(ModuleInfo, RightInst),
+
+ % mode is output.
+ mode_to_arg_mode(ModuleInfo, Mode, Type, ArgMode),
+ ArgMode = top_out,
+
+ % type is not primitive
+ \+ type_is_atomic(Type, ModuleInfo)
),
- ss_fixpoint_table_new_as(ModuleInfo, ProcInfo, PPId, Sharing,
- !FixpointTable),
+ list.filter(Test, ModeTypePairs, TrueModeTypePairs),
+ TrueModeTypePairs = [].
- maybe_write_string(Verbose, "\t\t (ft = " ++
- ss_fixpoint_table_description(!.FixpointTable) ++ ")\n", !IO).
+%-----------------------------------------------------------------------------%
+%
+% Structure sharing analysis of goals
+%
:- pred analyse_goal(module_info::in, pred_info::in, proc_info::in,
sharing_as_table::in, hlds_goal::in,
@@ -361,18 +402,28 @@
unexpected(this_file, "analyse_goal: shorthand goal.")
).
+%-----------------------------------------------------------------------------%
+%
+% Additional code for analysing disjuctions
+%
+
:- pred analyse_disj(module_info::in, pred_info::in, proc_info::in,
sharing_as_table::in, sharing_as::in, hlds_goal::in,
ss_fixpoint_table::in, ss_fixpoint_table::out,
sharing_as::in, sharing_as::out, io::di, io::uo) is det.
-analyse_disj(ModuleInfo, PredInfo, ProcInfo, SharingTable, Sharing0,
+analyse_disj(ModuleInfo, PredInfo, ProcInfo, SharingTable, SharingBeforeDisj,
Goal, !FixpointTable, !Sharing, !IO) :-
analyse_goal(ModuleInfo, PredInfo, ProcInfo, SharingTable, Goal,
- !FixpointTable, Sharing0, GoalSharing, !IO),
+ !FixpointTable, SharingBeforeDisj, GoalSharing, !IO),
!:Sharing = sharing_as_least_upper_bound(ModuleInfo, ProcInfo, !.Sharing,
GoalSharing).
+%-----------------------------------------------------------------------------%
+%
+% Additional code for analysing switches
+%
+
:- pred analyse_case(module_info::in, pred_info::in, proc_info::in,
sharing_as_table::in, sharing_as::in, case::in,
ss_fixpoint_table::in, ss_fixpoint_table::out,
@@ -387,12 +438,15 @@
CaseSharing).
%-----------------------------------------------------------------------------%
-
+%
+% Code for handling calls
+%
+
% Lookup the sharing information of a procedure identified by its
% pred_proc_id.
% 1 - first look in the fixpoint table (which may change the state
% of this table wrt recursiveness);
- % 2 - then look in sharing_s_table (as we might already have analysed
+ % 2 - then look in sharing_as_table (as we might already have analysed
% the predicate, if defined in same module, or analysed in other
% imported module)
% 3 - try to predict bottom;
@@ -446,24 +500,15 @@
% 2. bottom_sharing_is_safe_approximation
bottom_sharing_is_safe_approximation(ModuleInfo, ProcInfo)
;
- % 3. call to builtin/private_builtin procedures, namely
- % "unify", "index" or "compare".
- PredName = pred_info_name(PredInfo),
- PredArity = pred_info_orig_arity(PredInfo),
- (
- special_pred_name_arity(_, PredName, _, PredArity)
- ;
- special_pred_name_arity(_, _, PredName, PredArity)
- )
+ % 3. call to a compiler generate special predicate:
+ % "unify", "index", "compare" or "initialise".
+ pred_info_get_origin(PredInfo, Origin),
+ Origin = special_pred(_)
;
% 4. (XXX UNSAFE!! To verify) any call to private_builtin and builtin
% procedures.
PredModule = pred_info_module(PredInfo),
- (
- mercury_private_builtin_module(PredModule)
- ;
- mercury_public_builtin_module(PredModule)
- )
+ any_mercury_builtin_module(PredModule)
).
:- func top_sharing_not_found(module_info, pred_proc_id) = sharing_as.
@@ -482,40 +527,6 @@
%-----------------------------------------------------------------------------%
- % Succeeds if the sharing of a procedure can safely be approximated by
- % "bottom", simply by looking at the modes and types of the arguments.
- %
-:- pred bottom_sharing_is_safe_approximation(module_info::in,
- proc_info::in) is semidet.
-
-bottom_sharing_is_safe_approximation(ModuleInfo, ProcInfo) :-
- proc_info_headvars(ProcInfo, HeadVars),
- proc_info_argmodes(ProcInfo, Modes),
- proc_info_vartypes(ProcInfo, VarTypes),
- list.map(map.lookup(VarTypes), HeadVars, Types),
-
- ModeTypePairs = assoc_list.from_corresponding_lists(Modes, Types),
-
- Test = (pred(Pair::in) is semidet :-
- Pair = Mode - Type,
-
- % mode is not unique nor clobbered.
- mode_get_insts(ModuleInfo, Mode, _LeftInst, RightInst),
- \+ inst_is_unique(ModuleInfo, RightInst),
- \+ inst_is_clobbered(ModuleInfo, RightInst),
-
- % mode is output.
- mode_to_arg_mode(ModuleInfo, Mode, Type, ArgMode),
- ArgMode = top_out,
-
- % type is not primitive
- \+ type_is_atomic(Type, ModuleInfo)
- ),
- list.filter(Test, ModeTypePairs, TrueModeTypePairs),
- TrueModeTypePairs = [].
-
-%-----------------------------------------------------------------------------%
-
:- pred update_sharing_in_table(ss_fixpoint_table::in, pred_proc_id::in,
sharing_as_table::in, sharing_as_table::out) is det.
@@ -684,8 +695,8 @@
\+ is_unify_or_compare_pred(PredInfo),
% XXX These should be allowed, but the predicate declaration for the
- % specialized predicate is not produced before the termination pragmas
- % are read in, resulting in an undefined predicate error.
+ % specialized predicate is not produced before the structure_sharing
+ % pramgas are read in, resulting in an undefined predicate error.
\+ set.member(PredId, TypeSpecForcePreds)
->
PredName = pred_info_name(PredInfo),
Index: compiler/structure_sharing.domain.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/structure_sharing.domain.m,v
retrieving revision 1.3
diff -u -r1.3 structure_sharing.domain.m
--- compiler/structure_sharing.domain.m 1 Mar 2006 03:21:19 -0000 1.3
+++ compiler/structure_sharing.domain.m 3 Mar 2006 04:19:17 -0000
@@ -96,8 +96,8 @@
% * vars(SharingOut) is a subset of Vars.
% * vars(SharingIn minus SharingOut) union Vars = emptyset.
%
-:- pred sharing_as_project(prog_vars::in,
- sharing_as::in, sharing_as::out) is det.
+:- pred sharing_as_project(prog_vars::in, sharing_as::in, sharing_as::out)
+ is det.
:- pred sharing_as_project_set(set(prog_var)::in,
sharing_as::in, sharing_as::out) is det.
@@ -204,9 +204,9 @@
% Sharing table
%
-% This table used to temporarily record the sharing analysis results, instead
-% of saving in the HLDS and having to continuously convert between the public
-% and private representation of structure sharing.
+% This table is used to temporarily record the sharing analysis results,
+% instead of saving in the HLDS and having to continuously convert between the
+% public and private representation of structure sharing.
% Mapping between pred_proc_ids and sharing information that has been
% derived for the corresponding procedure definitions.
@@ -453,15 +453,11 @@
:- pred number_args(prog_vars::in, list(pair(int, prog_var))::out) is det.
number_args(Args, NumberedArgs) :-
- list.map_foldl(
- pred(A::in, AP::out, Nin::in, Nout::out) is det:-
- (
- AP = Nin - A,
- Nout = Nin + 1
- ),
- Args,
- NumberedArgs,
- 1, _).
+ NumberArg = (pred(A::in, AP::out, !.N::in, !:N::out) is det :-
+ AP = !.N - A,
+ !:N = !.N + 1
+ ),
+ list.map_foldl(NumberArg, Args, NumberedArgs, 1, _).
:- pred add_var_arg_sharing(module_info::in, proc_info::in, prog_var::in,
cons_id::in, pair(int, prog_var)::in,
@@ -500,17 +496,18 @@
(
NumberedArgs = [First | Remainder],
First = Pos1 - Var1,
- list.foldl(
- pred(OtherNumberedArg::in, S0::in, S::out) is det :-
+ AddPair = (pred(OtherNumberedArg::in,
+ !.Sharing::in, !:Sharing::out) is det :-
( OtherNumberedArg = Pos2 - Var1 ->
% Create sharing between Pos1 and Pos2
Data1 = datastruct_init_with_pos(Var, ConsId, Pos1),
Data2 = datastruct_init_with_pos(Var, ConsId, Pos2),
- new_entry(ModuleInfo, ProcInfo, Data1 - Data2, S0, S)
+ new_entry(ModuleInfo, ProcInfo, Data1 - Data2, !Sharing)
;
- S = S0
- ),
- Remainder, !Sharing),
+ true
+ )
+ ),
+ list.foldl(AddPair, Remainder, !Sharing),
create_internal_sharing(ModuleInfo, ProcInfo, Var, ConsId, Remainder,
!Sharing)
;
@@ -529,10 +526,11 @@
optimize_for_deconstruct(GoalInfo, !NumberedArgs) :-
hlds_llds.goal_info_get_pre_births(GoalInfo, PreBirthSet),
- list.filter((pred(NumberedArg::in) is semidet :-
- NumberedArg = _N - Var,
- set.member(Var, PreBirthSet)
- ), !NumberedArgs).
+ IsPreBirthArg = (pred(NumberedArg::in) is semidet :-
+ Var = snd(NumberedArg),
+ set.member(Var, PreBirthSet)
+ ),
+ list.filter(IsPreBirthArg, !NumberedArgs).
:- func optimization_remove_deaths(proc_info, hlds_goal_info,
sharing_as) = sharing_as.
@@ -540,7 +538,7 @@
optimization_remove_deaths(ProcInfo, GoalInfo, Sharing0) = Sharing :-
proc_info_headvars(ProcInfo, HeadVars),
set.list_to_set(HeadVars, HeadVarsSet),
- hlds_llds.goal_info_get_post_deaths(GoalInfo, Deaths0),
+ goal_info_get_post_deaths(GoalInfo, Deaths0),
%
% Make sure to keep all the information about the headvars,
% even if they are in the post deaths set.
@@ -549,7 +547,7 @@
set.to_sorted_list(Deaths, DeathsList),
sharing_as_project_with_type(outproject, DeathsList, Sharing0, Sharing).
-sharing_as_is_subsumed_by(ModuleInfo, ProcInfo, Sharing1, Sharing2):-
+sharing_as_is_subsumed_by(ModuleInfo, ProcInfo, Sharing1, Sharing2) :-
(
Sharing2 = top(_)
;
@@ -786,6 +784,7 @@
;
SharingAs = real_as(SharingSet)
).
+
wrap(SharingSet) = SharingAs :-
wrap(SharingSet, SharingAs).
@@ -846,7 +845,7 @@
% ;
% map.det_insert(!.Map, Var, SelectorSet1, !:Map)
% )
- map.det_insert(!.Map, Var, SelectorSet, !:Map).
+ svmap.det_insert(Var, SelectorSet, !Map).
% The implementation for combining sharing sets is to compute the
% alternating closure of those sets.
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list