[m-rev.] for post-commit review/diff: clean up formatting of CTGC modules
Julien Fischer
juliensf at cs.mu.OZ.AU
Mon Feb 27 17:40:38 AEDT 2006
For post-commit review by Nancy.
Clean up (some of) the formatting of the recently committed CTGC modules so
that they conform more closely to our coding standards. I made these changes
whilst reviewing these modules but its quicker just to fix little things like
this directly rather than post them as review comments (I'll post the actual
review comments separately). There are no changes to any algorithms.
compiler/ctgc.m:
compiler/ctgc.datastruct.m:
compiler/ctgc.fixpoint_table.m:
compiler/ctgc.selector.m:
compiler/ctgc.util.m:
compiler/prog_ctgc.m:
compiler/prog_data.m:
compiler/structure_sharing.m:
compiler/structure_sharing.analysis.m:
compiler/structure_sharing.domain.m:
Use four-space indentation in all of these modules.
Fix inconsistent indentation.
Use state variables in more places.
Use switches in preference to if-then-elses.
Use procedures from the sv* modules where appropriate.
s/io__state/io/
Remove unnecessary module qualification.
Lots of other minor formatting changes.
Julien.
Index: compiler/ctgc.datastruct.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ctgc.datastruct.m,v
retrieving revision 1.1
diff -u -b -r1.1 ctgc.datastruct.m
--- compiler/ctgc.datastruct.m 22 Feb 2006 08:05:06 -0000 1.1
+++ compiler/ctgc.datastruct.m 27 Feb 2006 05:53:19 -0000
@@ -1,18 +1,20 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 2006 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.
%-----------------------------------------------------------------------------%
-%
-% File: ctgc.datastruct.m
-% Main authors: nancy
-%
+
+% File: ctgc.datastruct.m.
+% Main author: nancy.
+
% Definition of predicates and functions for the manipulation of
% datastructures.
+
%-----------------------------------------------------------------------------%
:- module transform_hlds.ctgc.datastruct.
-
:- interface.
:- import_module parse_tree.prog_data.
@@ -21,6 +23,8 @@
:- import_module list.
+%-----------------------------------------------------------------------------%
+
% Create an initial top-datastruct of the given variable.
%
:- func init(prog_var) = datastruct.
@@ -66,12 +70,16 @@
:- pred apply_widening(module_info::in, proc_info::in, datastruct::in,
datastruct::out) is det.
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
:- implementation.
:- import_module transform_hlds.ctgc.selector.
:- import_module map.
+%-----------------------------------------------------------------------------%
init(V) = init(V, []).
init(V, Sel) = selected_cel(V, Sel).
@@ -127,4 +135,6 @@
apply_widening(ModuleInfo, Type, Sel0, Sel),
!:Data = init(Var, Sel).
+%-----------------------------------------------------------------------------%
:- end_module transform_hlds.ctgc.datastruct.
+%-----------------------------------------------------------------------------%
Index: compiler/ctgc.fixpoint_table.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ctgc.fixpoint_table.m,v
retrieving revision 1.1
diff -u -b -r1.1 ctgc.fixpoint_table.m
--- compiler/ctgc.fixpoint_table.m 22 Feb 2006 08:05:06 -0000 1.1
+++ compiler/ctgc.fixpoint_table.m 27 Feb 2006 04:41:59 -0000
@@ -1,20 +1,21 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 2006 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.
%-----------------------------------------------------------------------------%
-%
-% File: ctgc.fixpoint_table.m
+
+% File: ctgc.fixpoint_table.m.
% Main author: nancy.
-%
+
% This module defines a generic table to be used for fixpoint computations.
-% The purpose of this table is mainly to map pred_proc_id's onto abstract
+% The purpose of this table is mainly to map pred_proc_ids onto abstract
% substitutions representing either structure sharing or structure reuse.
-%
+
%-----------------------------------------------------------------------------%
:- module transform_hlds.ctgc.fixpoint_table.
-
:- interface.
:- import_module list.
@@ -22,8 +23,9 @@
:- type fixpoint_table(K, E).
% Initialise the table.
- % The first parameter is a function that produces the initial value
- % for each of the keys that are to be inserted into the table.
+ % The first parameter is a function that produces the initial value for
+ % each of the keys that are to be inserted into the table.
+ %
:- func init(func(K) = E, list(K)) = fixpoint_table(K, E).
% Inform the table that a new run has begun.
@@ -81,6 +83,7 @@
:- func get_final_semidet(K, fixpoint_table(K,E)) = E is semidet.
%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
:- implementation.
@@ -91,6 +94,9 @@
:- import_module list.
:- import_module map.
:- import_module require.
+:- import_module svmap.
+
+%-----------------------------------------------------------------------------%
:- type fixpoint_table(K, E)
---> ft(
@@ -103,12 +109,16 @@
:- type fp_entry(E)
---> entry(
bool, % stability: yes = stable, no = unstable
- E).
+ E
+ ).
+
+%-----------------------------------------------------------------------------%
:- func fp_entry_init(E) = fp_entry(E).
:- func fp_entry_stability(fp_entry(E)) = bool.
:- func fp_entry_elem(fp_entry(E)) = E.
:- func fp_entry_init(bool, E) = fp_entry(E).
+
fp_entry_init(Elem) = entry(no, Elem).
fp_entry_init(Bool, Elem) = entry(Bool, Elem).
fp_entry_stability(entry(S, _)) = S.
@@ -117,16 +127,11 @@
init(InitFunction, Ks) = ft(Ks, Run, IsRecursive, Map) :-
Run = 0,
IsRecursive = no,
- map__init(Map0),
- list__foldl(
- (pred(K::in, M0::in, M::out) is det :-
+ InsertElement = (pred(K::in, !.Map::in, !:Map::out) is det :-
E = InitFunction(K),
- map__det_insert(M0, K, fp_entry_init(E), M)
+ svmap.det_insert(K, fp_entry_init(E), !Map)
),
- Ks,
- Map0,
- Map
- ).
+ list.foldl(InsertElement, Ks, map.init, Map).
new_run(T0, T0 ^ run := T0 ^ run + 1).
which_run(T0) = T0 ^ run.
@@ -140,9 +145,11 @@
map__foldl(
pred(_K::in, Entry::in, S0::in, S::out) is det :-
(
- ( S0 = no ->
+ (
+ S0 = no,
S = no
;
+ S0 = yes,
S = fp_entry_stability(Entry)
)
),
@@ -153,13 +160,11 @@
true
).
-description(T) = Descr :-
- (
- fixpoint_reached(T)
- ->
- Descr = "stable"
+description(T) =
+ ( fixpoint_reached(T) ->
+ "stable"
;
- Descr = "unstable"
+ "unstable"
).
@@ -174,15 +179,16 @@
;
S = no
),
-
- % whether or not the tabled element is equal to the new element, the
- % final tabled element will always be set to the new one. This is handy
- % for performing the following trick: equality can be checked on some
- % partial piece of the elements (for deciding stability), but some
- % other part might have changed, a change that should become visible in
- % the table too. (in fact this is necessary for the reuse-fixpoint
- % table where not only the reuses are kept (the abstract substitution),
- % but also the goal that might have changed.
+ %
+ % Whether or not the tabled element is equal to the new element, the final
+ % tabled element will always be set to the new one. This is handy for
+ % performing the following trick: equality can be checked on some partial
+ % piece of the elements (for deciding stability), but some other part
+ % might have changed, a change that should become visible in the table
+ % too. (in fact this is necessary for the reuse-fixpoint table where not
+ % only the reuses are kept (the abstract substitution), but also the goal
+ % that might have changed.
+ %
FinalTabledElem = fp_entry_init(S, Elem),
map__det_update(Map, Index, FinalTabledElem, MapOut),
Tout = (Tin ^ mapping := MapOut).
@@ -209,5 +215,11 @@
map__search(T ^ mapping, Index, Entry),
Elem = fp_entry_elem(Entry).
+%-----------------------------------------------------------------------------%
+
:- func this_file = string.
+
this_file = "ctgc.fixpoint_table".
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
Index: compiler/ctgc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ctgc.m,v
retrieving revision 1.2
diff -u -b -r1.2 ctgc.m
--- compiler/ctgc.m 22 Feb 2006 08:05:06 -0000 1.2
+++ compiler/ctgc.m 23 Feb 2006 06:46:02 -0000
@@ -3,17 +3,16 @@
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
-%
+
% File: ctgc.m
% Main author: nancy
-%
+
% Package grouping all the modules that are used for compile-time garbage
% collection.
-%
+
%-----------------------------------------------------------------------------%
:- module transform_hlds.ctgc.
-
:- interface.
:- import_module parse_tree.
Index: compiler/ctgc.selector.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ctgc.selector.m,v
retrieving revision 1.1
diff -u -b -r1.1 ctgc.selector.m
--- compiler/ctgc.selector.m 22 Feb 2006 08:05:06 -0000 1.1
+++ compiler/ctgc.selector.m 27 Feb 2006 05:58:31 -0000
@@ -5,16 +5,15 @@
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
-%
-% File: ctgc.selector.m
-% Main authors: nancy
-%
-% Definition of predicates and functions for the manipulation of
-% selectors.
+
+% File: ctgc.selector.m.
+% Main author: nancy.
+
+% Definition of predicates and functions for the manipulation of selectors.
+
%-----------------------------------------------------------------------------%
:- module transform_hlds.ctgc.selector.
-
:- interface.
:- import_module hlds.hlds_module.
@@ -22,6 +21,8 @@
:- import_module list.
+%-----------------------------------------------------------------------------%
+
% Create a selector as either the top selector, a term selector,
% or a type selector.
%
@@ -38,7 +39,8 @@
% Returns true if Selector0 is subsumed by Selector1. This means that
% Selector1 is more general than Selector0, hence, there exists an
% extension Ext, such that Selector1.Extension = Selector0.
- % Note that the type specifies the type of the term to which the selectors
+ %
+ % NOTE: the type specifies the type of the term to which the selectors
% refer.
%
:- pred subsumed_by(module_info::in, selector::in, selector::in,
@@ -64,6 +66,9 @@
:- pred apply_widening(module_info::in, mer_type::in,
selector::in, selector::out) is det.
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
:- implementation.
:- import_module check_hlds.type_util.
@@ -76,6 +81,8 @@
:- import_module std_util.
:- import_module string.
+%-----------------------------------------------------------------------------%
+
top_selector = [].
init(Cons, Index) = [termsel(Cons, Index)].
init(Types) =
@@ -112,24 +119,24 @@
type_on_path(ModuleInfo, type_of_node(ModuleInfo, MainType, S2_part1),
SubType, Rest, Remainder),
- % step 3: % S2_part1.TS.S1_part2 should be more general than S1.
+ % step 3:
+ % % S2_part1.TS.S1_part2 should be more general than S1.
subsumed_by_2(ModuleInfo, Remainder, S2_part2, SubType, Extension)
;
- % If the second selector S2 has no type-
- % selectors, we have the simple case where S1 can be more
- % general than S2 if there exists a path "Extension" such that
- % S1.Extension = S2
+ % If the second selector S2 has no type-selectors, we have the
+ % simple case where S1 can be more general than S2 if there exists
+ % a path "Extension" such that S1.Extension = S2
subsumed_by(S1, S2, Extension)
).
:- pred subsumed_by(selector::in, selector::in, selector::out) is semidet.
+
subsumed_by(S1, S2, Extension):-
list.append(S2, Extension, S1).
type_of_node(ModuleInfo, StartType, Selector) = SubType :-
(
- Selector = [ UnitSelector | RestSelector ]
- ->
+ Selector = [ UnitSelector | RestSelector ],
(
UnitSelector = termsel(ConsId, Index),
SubType0 = select_subtype(ModuleInfo, StartType, ConsId, Index)
@@ -138,6 +145,7 @@
),
SubType = type_of_node(ModuleInfo, SubType0, RestSelector)
;
+ Selector = [],
SubType = StartType
).
@@ -164,12 +172,12 @@
unexpected(this_file, "get_type_of_node: existential type.")
).
-
-
- % split_upto_type_selector(Sin, S1, TS, S2):
+ % 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_selector::out, selector::out) is semidet.
@@ -178,26 +186,30 @@
Remainder = [TS | S2 ].
:- pred is_term_selector(unit_selector::in) is semidet.
+
is_term_selector(termsel(_, _)).
- % type_on_path(ModuleInfo, FromType, ToType, Path, Remainder):
+ % type_on_path(ModuleInfo, FromType, ToType, Path, Remainder).
+ %
% This predicate verifies that the path Path starting from FromType
% encounters at least one type node with the type ToType. Remainder is the
% remainder of the Path after stripping it to the last encounter of a node
% with "ToType".
+ %
% XXX Changed w.r.t. original implementation!
%
:- pred type_on_path(module_info::in, mer_type::in, mer_type::in,
selector::in, selector::out) is semidet.
type_on_path(ModuleInfo, FromType, ToType, Path, RemainderPath) :-
+ %
% In checking this, at least one step of the Path must be done. Indeed, if
% FromType = ToType, than RemainderPath would be equal to Path, which would
- % contradict the actual meaning of a type selector: A type-selector is a
+ % contradict the actual meaning of a type selector: a type-selector is a
% shortcut notation for any non-zero (!) selector that selects a node of
% the type described by the type-selector.
- type_on_path_2(first, ModuleInfo, FromType,
- ToType, Path, RemainderPath).
+ %
+ type_on_path_2(first, ModuleInfo, FromType, ToType, Path, RemainderPath).
% In checking whether a type is encountered on a given selector-path
% we check whether the type of a selector is encountered _after_ the first
@@ -276,16 +288,12 @@
normalize_wti(ModuleInfo, Type, BranchMap1, top_selector, !Selector)
).
-
:- pred normalize_wti(module_info::in, mer_type::in, branch_map::in,
selector::in, selector::in, selector::out) is det.
-
-normalize_wti(ModuleInfo, VarType, BranchMap0, SelectorAcc0,
- !Selector) :-
+normalize_wti(ModuleInfo, VarType, BranchMap0, SelectorAcc0, !Selector) :-
(
- !.Selector = [ UnitSelector | SelRest ]
- ->
+ !.Selector = [ UnitSelector | SelRest ],
Class = classify_type(ModuleInfo, VarType),
(
Class = type_cat_user_ctor
@@ -337,24 +345,23 @@
append(SelectorAcc0, !Selector)
)
;
- % SEL0 = []
+ !.Selector = [],
!:Selector = SelectorAcc0
).
apply_widening(ModuleInfo, MainType, !Selector) :-
(
!.Selector = []
- ->
- true
;
+ !.Selector = [_|_],
UnitSelector = typesel(type_of_node(ModuleInfo, MainType, !.Selector)),
!:Selector = [UnitSelector]
).
-
%-----------------------------------------------------------------------------%
+%
% BRANCH_MAP : copy/pasted from wimvh/bta_reduce.m
-%-----------------------------------------------------------------------------%
+%
:- type branch_map == assoc_list(mer_type, selector).
@@ -383,8 +390,11 @@
branch_map_search(Ms, T2, S)
).
-
%-----------------------------------------------------------------------------%
:- func this_file = string.
+
this_file = "ctgc.selector.m".
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
Index: compiler/ctgc.util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ctgc.util.m,v
retrieving revision 1.1
diff -u -b -r1.1 ctgc.util.m
--- compiler/ctgc.util.m 22 Feb 2006 08:05:06 -0000 1.1
+++ compiler/ctgc.util.m 27 Feb 2006 06:16:32 -0000
@@ -1,18 +1,19 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 2006 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.
%-----------------------------------------------------------------------------%
-%
-% File: ctgc.util.m
-% Main authors: nancy
-%
+
+% File: ctgc.util.m.
+% Main author: nancy.
+
% Utility operations for the CTGC-system.
-%
+
%-----------------------------------------------------------------------------%
:- module transform_hlds.ctgc.util.
-
:- interface.
:- import_module hlds.hlds_module.
@@ -20,46 +21,54 @@
:- import_module list.
+%-----------------------------------------------------------------------------%
+
% Check if some of the predicates are "special" predicates (as in
% "special_pred_map" known from module_info) or not defined in the
% current module, as these predicates are not analysed by the CTGC
% system.
%
-:- pred preds_requiring_no_analysis(module_info::in,
- list(pred_proc_id)::in) is semidet.
+:- pred preds_requiring_no_analysis(module_info::in, list(pred_proc_id)::in)
+ is semidet.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
:- implementation.
:- import_module bool.
:- import_module map.
-preds_requiring_no_analysis(ModuleInfo, PredProcIds) :-
+%-----------------------------------------------------------------------------%
+
+preds_requiring_no_analysis(ModuleInfo, PPIds) :-
module_info_get_special_pred_map(ModuleInfo, SpecialPredMap),
map.values(SpecialPredMap, SpecialPreds),
(
-
- list.filter(pred_id_in(SpecialPreds), PredProcIds,
- SpecialPredProcs),
+ list.filter(pred_id_in(SpecialPreds), PPIds, SpecialPredProcs),
SpecialPredProcs = [_|_]
-
;
% or some of the predicates are not defined in this
% module.
list.filter(not_defined_in_this_module(ModuleInfo),
- PredProcIds, FilteredPredProcIds),
- FilteredPredProcIds = [_|_]
+ PPIds, FilteredPPIds),
+ FilteredPPIds = [_|_]
).
:- pred pred_id_in(list(pred_id)::in, pred_proc_id::in) is semidet.
-pred_id_in(PredIds, PredProcId):-
- PredProcId = proc(PredId, _),
+
+pred_id_in(PredIds, PPId):-
+ PPId = proc(PredId, _),
list.member(PredId, PredIds).
-:- pred not_defined_in_this_module(module_info::in,
- pred_proc_id::in) is semidet.
+:- pred not_defined_in_this_module(module_info::in, pred_proc_id::in)
+ is semidet.
+
not_defined_in_this_module(ModuleInfo, proc(PredId, _)):-
module_info_pred_info(ModuleInfo, PredId, PredInfo),
pred_info_import_status(PredInfo, Status),
status_defined_in_this_module(Status, no).
+%-----------------------------------------------------------------------------%
:- end_module transform_hlds.ctgc.util.
+%-----------------------------------------------------------------------------%
Index: compiler/prog_ctgc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_ctgc.m,v
retrieving revision 1.1
diff -u -b -r1.1 prog_ctgc.m
--- compiler/prog_ctgc.m 22 Feb 2006 08:05:15 -0000 1.1
+++ compiler/prog_ctgc.m 27 Feb 2006 04:10:32 -0000
@@ -5,17 +5,16 @@
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
-%
-% File: prog_ctgc.m
-% Main author: nancy
-%
+
+% File: prog_ctgc.m.
+% Main author: nancy.
+
% Utility operations (parsing, printing, renaming) for compile-time garbage
% collection related information, i.e. structure sharing and structure reuse.
-%
+
%-----------------------------------------------------------------------------%
:- module parse_tree.prog_ctgc.
-
:- interface.
:- import_module parse_tree.prog_data.
@@ -28,8 +27,9 @@
:- import_module term.
%-----------------------------------------------------------------------------%
+%
% Parsing routines
-%-----------------------------------------------------------------------------%
+%
:- func parse_unit_selector(term(T)) = unit_selector.
:- func parse_selector(term(T)) = selector.
@@ -39,15 +39,15 @@
:- func parse_structure_sharing_domain(term(T)) = structure_sharing_domain.
%-----------------------------------------------------------------------------%
+%
% Printing routines
-%-----------------------------------------------------------------------------%
+%
-:- pred print_selector(tvarset::in, selector::in, io__state::di,
- io__state::uo) is det.
+:- pred print_selector(tvarset::in, selector::in, io::di, io::uo) is det.
:- pred print_datastruct(prog_varset::in, tvarset::in, datastruct::in,
- io__state::di, io__state::uo) is det.
+ io::di, io::uo) is det.
:- pred print_structure_sharing_pair(prog_varset::in, tvarset::in,
- structure_sharing_pair::in, io__state::di, io__state::uo) is det.
+ structure_sharing_pair::in, io::di, io::uo) is det.
% Print list of structure sharing pairs.
%
@@ -62,13 +62,13 @@
%
:- pred print_structure_sharing(prog_varset::in, tvarset::in,
maybe(int)::in, string::in, string::in, string::in,
- structure_sharing::in, io__state::di, io__state::uo) is det.
+ structure_sharing::in, io::di, io::uo) is det.
% Print complete list of structure sharing pairs as a list (using "[",
% ",", and "]"). This can later be parsed automatically.
%
:- pred print_structure_sharing(prog_varset::in, tvarset::in,
- structure_sharing::in, io__state::di, io__state::uo) is det.
+ structure_sharing::in, io::di, io::uo) is det.
% Print structure sharing domain.
%
@@ -84,23 +84,21 @@
% MaybeThreshold = no.
%
:- pred print_structure_sharing_domain(prog_varset::in, tvarset::in, bool::in,
- maybe(int)::in, structure_sharing_domain::in, io__state::di,
- io__state::uo) is det.
+ 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).
%
:- pred dump_maybe_structure_sharing_domain(prog_varset::in, tvarset::in,
- maybe(structure_sharing_domain)::in, io__state::di,
- io__state::uo) is det.
+ maybe(structure_sharing_domain)::in, io::di, io::uo) is det.
:- pred print_interface_structure_sharing_domain(prog_varset::in,
- tvarset::in, maybe(structure_sharing_domain)::in, io__state::di,
- io__state::uo) is det.
+ tvarset::in, maybe(structure_sharing_domain)::in, io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
-% Renaming operations.
-%-----------------------------------------------------------------------------%
+%
+% Renaming operations
+%
:- pred rename_unit_selector(tsubst::in, unit_selector::in,
unit_selector::out) is det.
@@ -119,6 +117,8 @@
structure_sharing_domain::out) is det.
%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
:- implementation.
:- import_module libs.compiler_util.
@@ -134,8 +134,9 @@
:- import_module varset.
%-----------------------------------------------------------------------------%
-% Implementation: Parsing routines
-%-----------------------------------------------------------------------------%
+%
+% Parsing routines
+%
parse_unit_selector(Term) = UnitSelector :-
(
@@ -146,37 +147,35 @@
Args = [ ConsTerm, ArityTerm, PosTerm ]
->
(
- prog_io__sym_name_and_args(ConsTerm, ConsIDName, []),
+ sym_name_and_args(ConsTerm, ConsIdName, []),
ArityTerm = term__functor(term__integer(Arity), _, _),
PosTerm = term__functor(term__integer(Pos), _, _)
->
- ConsID = cons(ConsIDName, Arity),
- UnitSelector = termsel(ConsID, Pos)
+ ConsId = cons(ConsIdName, Arity),
+ UnitSelector = termsel(ConsId, Pos)
;
ConsTerm = term__functor(term__integer(X), _, _)
->
- ConsID = int_const(X),
- UnitSelector = termsel(ConsID, 0)
+ ConsId = int_const(X),
+ UnitSelector = termsel(ConsId, 0)
;
ConsTerm = term__functor(term__float(X), _, _)
->
- ConsID = float_const(X),
- UnitSelector = termsel(ConsID, 0)
+ ConsId = float_const(X),
+ UnitSelector = termsel(ConsId, 0)
;
ConsTerm = term__functor(term__string(S), _, _)
->
- ConsID = string_const(S),
- UnitSelector = termsel(ConsID, 0)
+ ConsId = string_const(S),
+ UnitSelector = termsel(ConsId, 0)
;
unexpected(this_file, "parse_unit_selector: " ++
"unknown cons_id in unit selector")
)
;
-
Cons = "typesel",
Args = [ TypeSelectorTerm ]
->
-
parse_type(term__coerce(TypeSelectorTerm), MaybeTypeSelector),
(
MaybeTypeSelector = ok(TypeSelector),
@@ -194,7 +193,6 @@
unexpected(this_file, "parse_unit_selector: term not a functor")
).
-
parse_selector(Term) = Selector :-
(
Term = term__functor(term__atom(Cons), Args, _)
@@ -277,16 +275,18 @@
).
%-----------------------------------------------------------------------------%
-% Implementation: Printing routines
-%-----------------------------------------------------------------------------%
+%
+% Printing routines
+%
:- func selector_to_string(tvarset, selector) = string.
+
selector_to_string(TVarSet, Selector) = String :-
(
- Selector = []
- ->
+ Selector = [],
String = "[]"
;
+ Selector = [_|_],
SelectorStrings = list.map(unit_selector_to_string(TVarSet),
Selector),
string.append_list(["[",
@@ -295,6 +295,7 @@
).
:- func unit_selector_to_string(tvarset, unit_selector) = string.
+
unit_selector_to_string(_, termsel(ConsId, Index)) =
string.append_list(["sel(",
mercury_cons_id_to_string(ConsId, needs_brackets),
@@ -347,12 +348,11 @@
io.write_list(SharingPairs, Sep,
print_structure_sharing_pair(ProgVarSet, TypeVarSet), !IO),
(
- CompleteList = no
- ->
+ CompleteList = no,
io.write_string(Sep, !IO),
io.write_string("...", !IO)
;
- true
+ CompleteList = yes
),
io.write_string(End, !IO).
@@ -362,7 +362,7 @@
:- pred print_structure_sharing_domain(prog_varset::in, tvarset::in,
bool::in, maybe(int)::in, string::in, string::in, string::in,
- structure_sharing_domain::in, io__state::di, io__state::uo) is det.
+ structure_sharing_domain::in, io::di, io::uo) is det.
print_structure_sharing_domain(ProgVarSet, TypeVarSet, VerboseTop,
MaybeThreshold, Start, Separator, End, SharingAs, !IO) :-
@@ -396,8 +396,8 @@
dump_maybe_structure_sharing_domain(_, _, no, !IO) :-
io.write_string("% no sharing information available.\n", !IO).
-dump_maybe_structure_sharing_domain(ProgVarSet, TypeVarSet,
- yes(SharingAs), !IO) :-
+dump_maybe_structure_sharing_domain(ProgVarSet, TypeVarSet, yes(SharingAs),
+ !IO) :-
print_structure_sharing_domain(ProgVarSet, TypeVarSet, yes,
no, "%\t ", "\n%\t", "\n", SharingAs, !IO).
@@ -406,8 +406,8 @@
print_interface_structure_sharing_domain(ProgVarSet, TypeVarSet,
yes(SharingAs), !IO) :-
io.write_string("yes(", !IO),
- print_structure_sharing_domain(ProgVarSet, TypeVarSet, no,
- no, SharingAs, !IO),
+ print_structure_sharing_domain(ProgVarSet, TypeVarSet, no, no, SharingAs,
+ !IO),
io.write_string(")", !IO).
%-----------------------------------------------------------------------------%
@@ -443,5 +443,10 @@
rename_structure_sharing(Dict, TypeSubst, List0, List).
%-----------------------------------------------------------------------------%
+
:- func this_file = string.
+
this_file = "prog_ctgc.m".
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.155
diff -u -b -r1.155 prog_data.m
--- compiler/prog_data.m 24 Feb 2006 07:11:13 -0000 1.155
+++ compiler/prog_data.m 27 Feb 2006 06:01:20 -0000
@@ -301,13 +301,12 @@
%
% Stuff for the `structure_sharing_info' pragma.
%
-
-
% Whenever structure sharing analysis is unable to determine a good
% approximation of the set of structure sharing pairs that might exist
% during the execution of a program, it must use "top" as the only safe
% approximation. In order to collect some useful basic feedback information
% as to `why' a top was generated, we use:
+ %
:- type top_feedback == string.
% Elements of the structure sharing domain lattice are either bottom
@@ -324,8 +323,8 @@
:- type structure_sharing == list(structure_sharing_pair).
% A structure sharing pair represents the information that two
- % datastructures might be represented by the same memoryspace, hence
- % its representation as a pair of datastructures.
+ % data structures might be represented by the same memoryspace, hence
+ % its representation as a pair of datastructs.
%
:- type structure_sharing_pair == pair(datastruct).
Index: compiler/structure_sharing.analysis.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/structure_sharing.analysis.m,v
retrieving revision 1.4
diff -u -b -r1.4 structure_sharing.analysis.m
--- compiler/structure_sharing.analysis.m 24 Feb 2006 05:49:39 -0000 1.4
+++ compiler/structure_sharing.analysis.m 27 Feb 2006 06:19:41 -0000
@@ -5,17 +5,16 @@
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
-%
+
% File: structure_sharing.analysis.m
% Main authors: nancy
-%
+
% Implementation of the structure sharing analysis needed for compile-time
% garbage collection (CTGC).
-%
+
%-----------------------------------------------------------------------------%
:- module transform_hlds.ctgc.structure_sharing.analysis.
-
:- interface.
:- import_module hlds.hlds_module.
@@ -24,12 +23,17 @@
:- import_module io.
+%-----------------------------------------------------------------------------%
+
:- pred structure_sharing_analysis(module_info::in, module_info::out,
sharing_as_table::out, io::di, io::uo) is det.
:- pred write_pred_sharing_info(module_info::in, pred_id::in,
io::di, io::uo) is det.
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
:- implementation.
:- import_module check_hlds.inst_match.
@@ -49,6 +53,7 @@
:- import_module transform_hlds.ctgc.util.
:- import_module transform_hlds.dependency_graph.
+:- import_module assoc_list.
:- import_module bool.
:- import_module io.
:- import_module list.
@@ -57,6 +62,8 @@
:- import_module string.
:- import_module term.
+%-----------------------------------------------------------------------------%
+
structure_sharing_analysis(!ModuleInfo, SharingTable, !IO):-
% preliminary step:
% annotate the liveness (as in liveness.m)
@@ -68,7 +75,9 @@
sharing_analysis(!ModuleInfo, SharingTable0, SharingTable, !IO).
%-----------------------------------------------------------------------------%
-% Preliminary steps.
+%
+% Preliminary steps
+%
:- pred load_structure_sharing_table(module_info::in, sharing_as_table::out)
is det.
@@ -80,6 +89,7 @@
:- pred load_structure_sharing_table_2(module_info::in, pred_id::in,
sharing_as_table::in, sharing_as_table::out) is det.
+
load_structure_sharing_table_2(ModuleInfo, PredId, !SharingTable) :-
module_info_pred_info(ModuleInfo, PredId, PredInfo),
list.foldl(load_structure_sharing_table_3(ModuleInfo, PredId),
@@ -113,8 +123,7 @@
%-----------------------------------------------------------------------------%
:- pred sharing_analysis(module_info::in, module_info::out,
- sharing_as_table::in, sharing_as_table::out, io::di,
- io::uo) is det.
+ sharing_as_table::in, sharing_as_table::out, io::di, io::uo) is det.
sharing_analysis(!ModuleInfo, !SharingTable, !IO):-
% Perform the analysis based on the strongly connected components.
@@ -128,25 +137,25 @@
MaybeDepInfo = no,
unexpected(this_file, "No dependency information.")
),
-
+ %
% Record the sharing results in the HLDS.
+ %
map.foldl(save_sharing_in_module_info, !.SharingTable, !ModuleInfo).
:- pred save_sharing_in_module_info(pred_proc_id::in, sharing_as::in,
module_info::in, module_info::out) is det.
-save_sharing_in_module_info(PredProcId, SharingAs, !ModuleInfo) :-
- module_info_pred_proc_info(!.ModuleInfo, PredProcId, PredInfo0, ProcInfo0),
+save_sharing_in_module_info(PPId, SharingAs, !ModuleInfo) :-
+ module_info_pred_proc_info(!.ModuleInfo, PPId, PredInfo0, ProcInfo0),
proc_info_set_structure_sharing(to_structure_sharing_domain(SharingAs),
ProcInfo0, ProcInfo),
- module_info_set_pred_proc_info(PredProcId, PredInfo0, ProcInfo,
- !ModuleInfo).
+ module_info_set_pred_proc_info(PPId, PredInfo0, 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.
analyse_scc(ModuleInfo, SCC, !SharingTable, !IO):-
- ( ctgc.util.preds_requiring_no_analysis(ModuleInfo, SCC) ->
+ ( preds_requiring_no_analysis(ModuleInfo, SCC) ->
true
;
analyse_scc_until_fixpoint(ModuleInfo, SCC, !.SharingTable,
@@ -160,8 +169,8 @@
analyse_scc_until_fixpoint(ModuleInfo, SCC, SharingTable,
!FixpointTable, !IO) :-
- list.foldl2(analyse_pred_proc(ModuleInfo, SharingTable),
- SCC, !FixpointTable, !IO),
+ list.foldl2(analyse_pred_proc(ModuleInfo, SharingTable), SCC,
+ !FixpointTable, !IO),
( ss_fixpoint_table_stable(!.FixpointTable) ->
true
;
@@ -172,27 +181,27 @@
%-----------------------------------------------------------------------------%
%
-% The heart of it all, analysing a single procedure: analyse_pred_proc.
+% Perform structure sharing analysis on a procedure
%
:- pred analyse_pred_proc(module_info::in, sharing_as_table::in,
pred_proc_id::in, ss_fixpoint_table::in, ss_fixpoint_table::out,
io::di, io::uo) is det.
-analyse_pred_proc(ModuleInfo, SharingTable, PredProcId, !FixpointTable, !IO) :-
+analyse_pred_proc(ModuleInfo, SharingTable, PPId, !FixpointTable, !IO) :-
% Collect relevant compiler options.
globals.io_lookup_bool_option(very_verbose, Verbose, !IO),
globals.io_lookup_int_option(structure_sharing_widening, WideningLimit,
!IO),
% Collect relevant procedure information.
- module_info_pred_proc_info(ModuleInfo, PredProcId, PredInfo, ProcInfo),
- PredProcId = proc(PredId, ProcId),
+ 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(PredProcId,
+ TabledAsDescr = ss_fixpoint_table_get_short_description(PPId,
!.FixpointTable),
passes_aux.write_proc_progress_message(
"% Sharing analysis (run " ++ string.int_to_string(Run) ++ ") ",
@@ -234,7 +243,7 @@
Sharing = Sharing3
),
- ss_fixpoint_table_new_as(ModuleInfo, ProcInfo, PredProcId, Sharing,
+ ss_fixpoint_table_new_as(ModuleInfo, ProcInfo, PPId, Sharing,
!FixpointTable),
maybe_write_string(Verbose, "\t\t (ft = " ++
@@ -263,23 +272,22 @@
!.SharingAs)
)
;
- GoalExpr = call(CalledPredId, CalledProcId, Args, _, _, _),
- CalledPredProcId = proc(CalledPredId, CalledProcId),
- lookup_sharing(ModuleInfo, SharingTable, CalledPredProcId,
- !FixpointTable, CalledSharing),
+ GoalExpr = call(CalleePredId, CalleeProcId, CalleeArgs, _, _, _),
+ CalleePPId = proc(CalleePredId, CalleeProcId),
+ lookup_sharing(ModuleInfo, SharingTable, CalleePPId,
+ !FixpointTable, CalleeSharing),
% Rename
proc_info_vartypes(ProcInfo, AllTypes),
- list.map(map.lookup(AllTypes), Args, ActualTypes),
+ list.map(map.lookup(AllTypes), CalleeArgs, ActualTypes),
pred_info_typevarset(PredInfo, ActualTVarset),
- rename_using_module_info(ModuleInfo, CalledPredProcId,
- Args, ActualTypes, ActualTVarset, CalledSharing, RenamedSharing),
+ rename_using_module_info(ModuleInfo, CalleePPId, CalleeArgs,
+ ActualTypes, ActualTVarset, CalleeSharing, RenamedSharing),
% Combine
- !:SharingAs = comb(ModuleInfo, ProcInfo,
- RenamedSharing, !.SharingAs)
+ !:SharingAs = comb(ModuleInfo, ProcInfo, RenamedSharing, !.SharingAs)
;
GoalExpr = generic_call(_GenDetails, _, _, _),
goal_info_get_context(GoalInfo, Context),
@@ -376,16 +384,15 @@
:- pred lookup_sharing(module_info::in, sharing_as_table::in, pred_proc_id::in,
ss_fixpoint_table::in, ss_fixpoint_table::out, sharing_as::out) is det.
-lookup_sharing(ModuleInfo, SharingTable, PredProcId, !FixpointTable,
- SharingAs) :-
+lookup_sharing(ModuleInfo, SharingTable, PPId, !FixpointTable, SharingAs) :-
(
% 1 -- check fixpoint table
- ss_fixpoint_table_get_as(PredProcId, SharingAs0, !FixpointTable)
+ ss_fixpoint_table_get_as(PPId, SharingAs0, !FixpointTable)
->
SharingAs = SharingAs0
;
% 2 -- look up in SharingTable
- SharingAs0 = sharing_as_table_search(PredProcId, SharingTable)
+ SharingAs0 = sharing_as_table_search(PPId, SharingTable)
->
SharingAs = SharingAs0
;
@@ -395,19 +402,19 @@
% table, then this means that we have never analysed the called
% procedure, yet in some cases we can still simply predict that
% the sharing the called procedure creates is bottom.
- predict_called_pred_is_bottom(ModuleInfo, PredProcId)
+ predict_called_pred_is_bottom(ModuleInfo, PPId)
->
SharingAs = structure_sharing.domain.init
;
% 4 -- use top-sharing with appropriate message.
- SharingAs = top_sharing_not_found(ModuleInfo, PredProcId)
+ SharingAs = top_sharing_not_found(ModuleInfo, PPId)
).
:- pred predict_called_pred_is_bottom(module_info::in, pred_proc_id::in)
is semidet.
-predict_called_pred_is_bottom(ModuleInfo, PredProcId) :-
- module_info_pred_proc_info(ModuleInfo, PredProcId, PredInfo, ProcInfo),
+predict_called_pred_is_bottom(ModuleInfo, PPId) :-
+ module_info_pred_proc_info(ModuleInfo, PPId, PredInfo, ProcInfo),
(
% 1. inferred determinism is erroneous/failure.
proc_info_inferred_determinism(ProcInfo, Determinism),
@@ -442,9 +449,9 @@
:- func top_sharing_not_found(module_info, pred_proc_id) = sharing_as.
-top_sharing_not_found(ModuleInfo, PredProcId) = TopSharing :-
- module_info_pred_proc_info(ModuleInfo, PredProcId, PredInfo, _),
- PredProcId = proc(PredId, ProcId),
+top_sharing_not_found(ModuleInfo, PPId) = TopSharing :-
+ module_info_pred_proc_info(ModuleInfo, PPId, PredInfo, _),
+ PPId = proc(PredId, ProcId),
PredModuleName = pred_info_module(PredInfo),
TopSharing = top_sharing("Lookup sharing failed for " ++
@@ -456,9 +463,8 @@
%-----------------------------------------------------------------------------%
- % Predicate succeeds if the sharing of a procedure can safely be
- % approximated by "bottom", simply by looking at the modes and
- % types of the arguments.
+ % 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.
@@ -469,10 +475,9 @@
proc_info_vartypes(ProcInfo, VarTypes),
list.map(map.lookup(VarTypes), HeadVars, Types),
- MapToPair = (func(M, T) = Result :- Result = M - T),
- ModeTypePairs = list.map_corresponding(MapToPair, Modes, Types),
+ ModeTypePairs = assoc_list.from_corresponding_lists(Modes, Types),
- Test = ( pred(Pair::in) is semidet :-
+ Test = (pred(Pair::in) is semidet :-
Pair = Mode - Type,
% mode is not unique nor clobbered.
@@ -485,18 +490,18 @@
ArgMode = top_out,
% type is not primitive
- \+ type_util.type_is_atomic(Type, ModuleInfo)
+ \+ type_is_atomic(Type, ModuleInfo)
),
-
list.filter(Test, ModeTypePairs, []).
%-----------------------------------------------------------------------------%
:- pred update_sharing_in_table(ss_fixpoint_table::in, pred_proc_id::in,
sharing_as_table::in, sharing_as_table::out) is det.
-update_sharing_in_table(FixpointTable, PredProcId, !SharingTable):-
- sharing_as_table_set(PredProcId,
- ss_fixpoint_table_get_final_as(PredProcId, FixpointTable),
+
+update_sharing_in_table(FixpointTable, PPId, !SharingTable):-
+ sharing_as_table_set(PPId,
+ ss_fixpoint_table_get_final_as(PPId, FixpointTable),
!SharingTable).
%-----------------------------------------------------------------------------%
@@ -586,27 +591,26 @@
ss_fixpoint_table_description(Table) = fixpoint_table.description(Table).
ss_fixpoint_table_new_as(ModuleInfo, ProcInfo, Id, SharingAs, !Table):-
- fixpoint_table.add(
- structure_sharing.domain.is_subsumed_by(ModuleInfo, ProcInfo),
+ fixpoint_table.add(domain.is_subsumed_by(ModuleInfo, ProcInfo),
Id, SharingAs, !Table).
-ss_fixpoint_table_get_as(PredProcId, SharingAs, !Table) :-
- fixpoint_table.get(PredProcId, SharingAs, !Table).
+ss_fixpoint_table_get_as(PPId, SharingAs, !Table) :-
+ fixpoint_table.get(PPId, SharingAs, !Table).
-ss_fixpoint_table_get_short_description(PredProcId, Table) = Descr :-
+ss_fixpoint_table_get_short_description(PPId, Table) = Descr :-
(
- As = ss_fixpoint_table_get_final_as_semidet(PredProcId, Table)
+ As = ss_fixpoint_table_get_final_as_semidet(PPId, Table)
->
Descr = short_description(As)
;
Descr = "-"
).
-ss_fixpoint_table_get_final_as(PredProcId, T) =
- fixpoint_table.get_final(PredProcId, T).
+ss_fixpoint_table_get_final_as(PPId, T) =
+ fixpoint_table.get_final(PPId, T).
-ss_fixpoint_table_get_final_as_semidet(PredProcId, T) =
- fixpoint_table.get_final_semidet(PredProcId, T).
+ss_fixpoint_table_get_final_as_semidet(PPId, T) =
+ fixpoint_table.get_final_semidet(PPId, T).
%-----------------------------------------------------------------------------%
@@ -621,6 +625,8 @@
),
\+ is_unify_or_compare_pred(PredInfo)
->
+ % XXX We most probably need to handle predicate produced by type
+ % specialization here as well (see termination.m).
PredName = pred_info_name(PredInfo),
ProcIds = pred_info_procids(PredInfo),
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
@@ -630,22 +636,19 @@
SymName = qualified(ModuleName, PredName),
pred_info_typevarset(PredInfo, TypeVarSet),
list.foldl(
- (pred(ProcId::in, IO1::di, IO2::uo) is det :-
- write_proc_sharing_info(PredId, ProcId,
- ProcTable, PredOrFunc, SymName, Context,
- TypeVarSet, IO1, IO2)
- ),
+ write_proc_sharing_info(PredId, ProcTable, PredOrFunc,
+ SymName, Context, TypeVarSet),
ProcIds, !IO)
;
true
).
-:- pred write_proc_sharing_info(pred_id::in, proc_id::in, proc_table::in,
+:- pred write_proc_sharing_info(pred_id::in, proc_table::in,
pred_or_func::in, sym_name::in, prog_context::in, tvarset::in,
- io::di, io::uo) is det.
+ proc_id::in, io::di, io::uo) is det.
-write_proc_sharing_info(_PredId, ProcId, ProcTable, PredOrFunc, SymName,
- Context, TypeVarSet, !IO) :-
+write_proc_sharing_info(_PredId, ProcTable, PredOrFunc, SymName,
+ Context, TypeVarSet, ProcId, !IO) :-
globals.io_lookup_bool_option(structure_sharing_analysis,
SharingAnalysis, !IO),
(
Index: compiler/structure_sharing.domain.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/structure_sharing.domain.m,v
retrieving revision 1.1
diff -u -b -r1.1 structure_sharing.domain.m
--- compiler/structure_sharing.domain.m 22 Feb 2006 08:05:16 -0000 1.1
+++ compiler/structure_sharing.domain.m 27 Feb 2006 06:10:49 -0000
@@ -5,44 +5,50 @@
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
-%
-% File: ctgc.structure_sharing.domain.m
-% Main authors: nancy
-%
-% Definition of the abstract domain for representing structure sharing between
-% data structures.
+
+% File: ctgc.structure_sharing.domain.m.
+% Main author: nancy.
+
+% This module defines the abstract domain for representing structure sharing
+% between data structures.
+
% This domain forms a complete lattice. It has a bottom element (representing
% the definite absence of any possible structure sharing), and a top element
% (that represents any possible structure sharing), a least upper bound
% operation, and a comparison predicate (is_subsumed_by).
-%
+
% The auxiliary functions needed for using the domain within the abstract
% semantics on which the implementation of the analysis is based are:
+%
% * project: limit the abstract information to include only the
% information regarding some given set of variables.
+%
% * rename: given a mapping of variables, this operation renames every
% occurrence of a variable to its mapping.
+%
% * init: create an initial empty sharing set that represents the absence
% of any possible sharing.
+%
% * comb: combine new sharing information (that usually stems from a
% procedure call) with existing sharing such that the result correctly
% approximates the real sharing that would exist when new concrete
% sharing is added to existing sharing.
+%
% * add: add the sharing created by a primitive operation (unification)
% to any existing sharing.
-%
+
% Additional operations:
% * extend_datastruct: compute the set of datastructures referring to the
% same memory space as a given datastructure, using sharing information;
% needed by the reuse analysis to check whether a given datastructure is
% the last pointer to the memory space it refers to.
+%
% * conversion operations between the public and private representation
% for sharing sets.
-%
+
%-----------------------------------------------------------------------------%
:- module transform_hlds.ctgc.structure_sharing.domain.
-
:- interface.
:- import_module hlds.hlds_goal.
@@ -56,6 +62,8 @@
:- import_module set.
:- import_module string.
+%-----------------------------------------------------------------------------%
+
% The hidden representation for structure sharing.
%
:- type sharing_as.
@@ -89,8 +97,7 @@
% * vars(SharingIn minus SharingOut) union Vars = emptyset.
%
:- pred project(prog_vars::in, sharing_as::in, sharing_as::out) is det.
-:- pred project_set(set(prog_var)::in, sharing_as::in,
- sharing_as::out) is det.
+:- pred project_set(set(prog_var)::in, sharing_as::in, sharing_as::out) is det.
% Renaming operation.
% This operation renames the variables and type variables occurring
@@ -105,7 +112,7 @@
% using the module information. A list of variables and types is used as
% the actual variables and types.
% recorded in the module info.
- % rename_using_module_info(ModuleInfo, PredProcId, ActualVars, ActualTypes,
+ % rename_using_module_info(ModuleInfo, PPId, ActualVars, ActualTypes,
% FormalSharing, ActualSharing).
%
:- pred rename_using_module_info(module_info::in, pred_proc_id::in,
@@ -188,13 +195,16 @@
:- func to_structure_sharing_domain(sharing_as) = structure_sharing_domain.
%-----------------------------------------------------------------------------%
-% Sharing table. Table used to temporarely 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)
%
+% 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.
- % Mapping between pred_proc_id's and the sharing information that has
- % been derived for the corresponding procedure definitions.
+ % Mapping between pred_proc_ids and sharing information that has been
+ % derived for the corresponding procedure definitions.
%
:- type sharing_as_table == map(pred_proc_id, sharing_as).
@@ -214,6 +224,8 @@
sharing_as_table::in, sharing_as_table::out) is det.
%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
:- implementation.
:- import_module check_hlds.type_util.
@@ -225,10 +237,13 @@
:- import_module transform_hlds.ctgc.datastruct.
:- import_module transform_hlds.ctgc.selector.
-
:- import_module int.
:- import_module require.
:- import_module std_util.
+:- import_module svmap.
+:- import_module svset.
+
+%-----------------------------------------------------------------------------%
:- type sharing_as
---> real_as(sharing_set)
@@ -250,6 +265,7 @@
list.cons(Msg, Msgs0, Msgs)
),
TopSharing = top(Msgs).
+
is_top(top(_)).
size(bottom) = 0.
@@ -258,26 +274,30 @@
short_description(bottom) = "b".
short_description(top(_)) = "t".
short_description(real_as(SharingSet)) =
- string.int_to_string(sharing_set_size(SharingSet)).
+ string.from_int(sharing_set_size(SharingSet)).
% inproject = projection such that result contains information about
% selection of variables only.
+ %
% outproject = projection such that result contains information about
% all variables _except_ the selection of variables.
-:- type projection_type ---> inproject; outproject.
+ %
+:- type projection_type
+ ---> inproject
+ ; outproject.
project(ListVars, !SharingAs) :-
project(inproject, ListVars, !SharingAs).
:- pred project(projection_type::in, prog_vars::in, sharing_as::in,
sharing_as::out) is det.
+
project(ProjectionType, ListVars, !SharingAs) :-
(
!.SharingAs = bottom
;
!.SharingAs = real_as(SharingSet0),
- sharing_set_project(ProjectionType, ListVars, SharingSet0,
- SharingSet),
+ sharing_set_project(ProjectionType, ListVars, SharingSet0, SharingSet),
!:SharingAs = wrap(SharingSet)
;
!.SharingAs = top(_)
@@ -289,8 +309,7 @@
rename(MapVar, TypeSubst, !SharingAs) :-
(
!.SharingAs = real_as(SharingSet0),
- sharing_set_rename(MapVar, TypeSubst, SharingSet0,
- SharingSet),
+ sharing_set_rename(MapVar, TypeSubst, SharingSet0, SharingSet),
!:SharingAs = real_as(SharingSet)
;
!.SharingAs = bottom
@@ -298,9 +317,9 @@
!.SharingAs = top(_)
).
-rename_using_module_info(ModuleInfo, PredProcId, ActualVars, ActualTypes,
+rename_using_module_info(ModuleInfo, PPId, ActualVars, ActualTypes,
ActualTVarset, FormalSharing, ActualSharing):-
- module_info_pred_proc_info(ModuleInfo, PredProcId, PredInfo, ProcInfo),
+ module_info_pred_proc_info(ModuleInfo, PPId, PredInfo, ProcInfo),
% head variables.
proc_info_headvars(ProcInfo, FormalVars),
@@ -355,13 +374,13 @@
UnifSharing = sharing_from_unification(ModuleInfo, ProcInfo, Unification,
GoalInfo),
ResultSharing = comb(ModuleInfo, ProcInfo, UnifSharing, OldSharing),
-
+ %
% When the unification is a construction unification, some local variables
- % may become totally useless for the rest of the code (deaths), and so
- % any structure sharing involving these variables may safely be removed.
+ % may become totally useless for the rest of the code (deaths), and so any
+ % structure sharing involving these variables may safely be removed.
%
- % Note that this "useless" sharing information can not be removed earlier
- % as it can contribute to new sharing with the comb operation.
+ % NOTE: this "useless" sharing information can not be removed earlier as
+ % it can contribute to new sharing with the comb operation.
%
(
Unification = construct(_, _, _, _, _, _, _)
@@ -385,26 +404,26 @@
list.takewhile(is_introduced_typeinfo_arg(ProcInfo), Args0,
_TypeInfoArgs, Args),
number_args(Args, NumberedArgs),
- list.foldl(
- add_var_arg_sharing(ModuleInfo, ProcInfo, Var, ConsId),
- NumberedArgs,
- sharing_set_init,
- SharingSet0),
+ some [!SharingSet] (
+ !:SharingSet = sharing_set_init,
+ list.foldl(add_var_arg_sharing(ModuleInfo, ProcInfo, Var, ConsId),
+ NumberedArgs, !SharingSet),
create_internal_sharing(ModuleInfo, ProcInfo, Var, ConsId,
- NumberedArgs, SharingSet0, SharingSet),
- Sharing = wrap(SharingSet)
+ NumberedArgs, !SharingSet),
+ Sharing = wrap(!.SharingSet)
+ )
;
Unification = deconstruct(Var, ConsId, Args0, _, _, _),
list.takewhile(is_introduced_typeinfo_arg(ProcInfo), Args0,
_TypeInfoArgs, Args),
number_args(Args, NumberedArgs),
optimize_for_deconstruct(GoalInfo, NumberedArgs, ReducedNumberedArgs),
- list.foldl(
- add_var_arg_sharing(ModuleInfo, ProcInfo, Var, ConsId),
- ReducedNumberedArgs,
- sharing_set_init,
- SharingSet),
- Sharing = wrap(SharingSet)
+ some [!SharingSet] (
+ !:SharingSet = sharing_set_init,
+ list.foldl(add_var_arg_sharing(ModuleInfo, ProcInfo, Var, ConsId),
+ ReducedNumberedArgs, !SharingSet),
+ Sharing = wrap(!.SharingSet)
+ )
;
Unification = assign(X, Y),
(
@@ -426,12 +445,14 @@
).
:- pred is_introduced_typeinfo_arg(proc_info::in, prog_var::in) is semidet.
+
is_introduced_typeinfo_arg(ProcInfo, Var) :-
proc_info_vartypes(ProcInfo, VarTypes),
map.lookup(VarTypes, Var, Type),
is_introduced_type_info_type(Type).
:- 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:-
@@ -444,22 +465,23 @@
1, _).
:- pred add_var_arg_sharing(module_info::in, proc_info::in, prog_var::in,
- cons_id::in, pair(int, prog_var)::in, sharing_set::in,
- sharing_set::out) is det.
-add_var_arg_sharing(ModuleInfo, ProcInfo, Var, ConsId, N - Arg,
- Sharing0, Sharing) :-
+ cons_id::in, pair(int, prog_var)::in,
+ sharing_set::in, sharing_set::out) is det.
+
+add_var_arg_sharing(ModuleInfo, ProcInfo, Var, ConsId, N - Arg, !Sharing) :-
(
arg_has_primitive_type(ModuleInfo, ProcInfo, Arg)
->
- Sharing = Sharing0
+ true
;
Data1 = datastruct.init(Var, ConsId, N),
Data2 = datastruct.init(Arg),
- new_entry(ModuleInfo, ProcInfo, Data1 - Data2, Sharing0, Sharing)
+ new_entry(ModuleInfo, ProcInfo, Data1 - Data2, !Sharing)
).
:- pred arg_has_primitive_type(module_info::in, proc_info::in,
prog_var::in) is semidet.
+
arg_has_primitive_type(ModuleInfo, ProcInfo, Var):-
proc_info_vartypes(ProcInfo, VarTypes),
map.lookup(VarTypes, Var, Type),
@@ -469,9 +491,11 @@
% this must be recorded as an extra sharing pair.
% E.g.: X = f(Y,Y), then the sharing between f/1 and f/2 must be recorded.
% XXX Different implementation!
+ %
:- pred create_internal_sharing(module_info::in, proc_info::in,
prog_var::in, cons_id::in, list(pair(int, prog_var))::in,
sharing_set::in, sharing_set::out) is det.
+
create_internal_sharing(ModuleInfo, ProcInfo, Var, ConsId, NumberedArgs,
!Sharing) :-
% For every argument and the occurrence of the variable of that argument
@@ -499,34 +523,34 @@
NumberedArgs = []
).
- % For deconstructions, a huge optimization can be made by
- % avoiding the construction of sharing between variables that are not
- % used in the remainder of the code anyway. The set of used args is
- % known as the pre-birth set as computed by the liveness-pass (liveness.m).
+ % For deconstructions, a huge optimization can be made by avoiding the
+ % construction of sharing between variables that are not used in the
+ % remainder of the code anyway. The set of used args is known as the
+ % pre-birth set as computed by the liveness-pass (liveness.m).
+ %
% XXX Why was the original implementation so complicated?
+ %
:- pred optimize_for_deconstruct(hlds_goal_info::in,
- list(pair(int, prog_var))::in,
- list(pair(int, prog_var))::out) is det.
-optimize_for_deconstruct(GoalInfo, NumberedArgs0, NumberedArgs) :-
+ list(pair(int, prog_var))::in, list(pair(int, prog_var))::out) is det.
+
+optimize_for_deconstruct(GoalInfo, !NumberedArgs) :-
hlds_llds.goal_info_get_pre_births(GoalInfo, PreBirthSet),
- list.filter(
- pred(NumberedArg::in) is semidet :-
- (
+ list.filter((pred(NumberedArg::in) is semidet :-
NumberedArg = _N - Var,
set.member(Var, PreBirthSet)
- ),
- NumberedArgs0,
- NumberedArgs).
-
+ ), !NumberedArgs).
:- func optimization_remove_deaths(proc_info, hlds_goal_info,
sharing_as) = sharing_as.
+
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),
+ %
% Make sure to keep all the information about the headvars,
% even if they are in the post deaths set.
+ %
set.difference(Deaths0, HeadVarsSet, Deaths),
set.to_sorted_list(Deaths, DeathsList),
project(outproject, DeathsList, Sharing0, Sharing).
@@ -628,7 +652,6 @@
SharingAs = top(Msgs)
).
-
to_structure_sharing_domain(SharingAs) = SharingDomain :-
(
SharingAs = bottom,
@@ -642,14 +665,14 @@
).
%-----------------------------------------------------------------------------%
-% sharing_as_table:
+%
+% sharing_as_table
+%
sharing_as_table_init = map.init.
-sharing_as_table_search(PredProcId, Table) = Table^elem(PredProcId).
-sharing_as_table_set(PredProcId, Sharing, Table0, Table) :-
- Table = Table0^elem(PredProcId) := Sharing.
-
-
+sharing_as_table_search(PPId, Table) = Table ^ elem(PPId).
+sharing_as_table_set(PPId, Sharing, !Table) :-
+ !:Table = !.Table ^ elem(PPId) := Sharing.
%-----------------------------------------------------------------------------%
% Type: sharing_set.
@@ -721,7 +744,8 @@
).
%-----------------------------------------------------------------------------%
-% sharing_set predicates/functions.
+%
+% sharing_set predicates/functions
%
:- func sharing_set_init = sharing_set is det.
@@ -731,12 +755,11 @@
:- pred wrap(sharing_set::in, sharing_as::out) is det.
:- func wrap(sharing_set) = sharing_as.
-:- pred sharing_set_project(projection_type::in,
- prog_vars::in, sharing_set::in,
- sharing_set::out) is det.
+:- pred sharing_set_project(projection_type::in, prog_vars::in,
+ sharing_set::in, sharing_set::out) is det.
+
:- pred sharing_set_rename(map(prog_var, prog_var)::in,
- tsubst::in, sharing_set::in,
- sharing_set::out) is det.
+ tsubst::in, sharing_set::in, sharing_set::out) is det.
:- func sharing_set_comb(module_info, proc_info, sharing_set, sharing_set) =
sharing_set.
@@ -756,13 +779,13 @@
% Conversion between list of sharing data structures to
% sharing_set's and vice versa.
%
- % Note: from_sharing_pair_list assumes that the sharing set is minimal, ie,
+ % NOTE: from_sharing_pair_list assumes that the sharing set is minimal, ie,
% there are no two sharing pairs in that set such that one sharing pair
% subsumes the other pair.
+ %
:- func from_sharing_pair_list(structure_sharing) = sharing_set.
:- func to_sharing_pair_list(sharing_set) = structure_sharing.
-
%-----------------------------------------------------------------------------%
sharing_set_init = sharing_set(0, map.init).
@@ -792,26 +815,20 @@
set.list_to_set(Vars), Remainder),
map.select(Map0, Remainder, Map1)
),
- map.foldl(
- pred(Var::in, SelSet0::in, S0::in, S::out) is det :-
- (
- selector_sharing_set_project(ProjectionType,
- Vars, SelSet0, SelSet),
+ map.foldl((pred(Var::in, SelSet0::in, !.S::in, !:S::out) is det :-
+ selector_sharing_set_project(ProjectionType, Vars,
+ SelSet0, SelSet),
(
selector_sharing_set_is_empty(SelSet)
->
- S = S0
+ true
;
- S0 = sharing_set(Size0, M0),
+ !.S = sharing_set(Size0, M0),
map.det_insert(M0, Var, SelSet, M),
- Size = Size0 +
- selector_sharing_set_size(SelSet),
- S = sharing_set(Size, M)
+ Size = Size0 + selector_sharing_set_size(SelSet),
+ !:S = sharing_set(Size, M)
)
- ),
- Map1,
- sharing_set_init,
- SharingSet).
+ ), Map1, sharing_set_init, SharingSet).
sharing_set_rename(Dict, TypeSubst, SharingSet0, SharingSet) :-
SharingSet0 = sharing_set(Size, Map0),
@@ -865,8 +882,9 @@
% * sharing pairs formed using paths of length three N - O - N, where
% N are sharing pairs from NewSharingSet, and O is a sharing pair from
% OldSharingSet.
-sharing_set_comb(ModuleInfo, ProcInfo, NewSharingSet, OldSharingSet) =
- ResultSharingSet :-
+ %
+sharing_set_comb(ModuleInfo, ProcInfo, NewSharingSet, OldSharingSet)
+ = ResultSharingSet :-
% paths of length 2:
OldNewSharingSet = sharing_set_altclos_2(ModuleInfo, ProcInfo,
@@ -885,8 +903,8 @@
:- func sharing_set_altclos_2(module_info, proc_info, sharing_set,
sharing_set) = sharing_set.
-sharing_set_altclos_2(ModuleInfo, ProcInfo, NewSharingSet,
- OldSharingSet) = ResultSharingSet :-
+sharing_set_altclos_2(ModuleInfo, ProcInfo, NewSharingSet, OldSharingSet)
+ = ResultSharingSet :-
NewSharingSet = sharing_set(_, NewMap),
OldSharingSet = sharing_set(_, OldMap),
@@ -905,23 +923,19 @@
map.select(OldMap, CommonVarsSet, OldMap1),
proc_info_vartypes(ProcInfo, VarTypes),
-
+ %
% for each common var V, compute the sharing pairs A-B, such that
% \exists X where var(X) = V, and X-A \in NewSharingSet, and X-B \in
% OldSharingSet.
- list.foldl(
- pred(Var::in, SS0::in, SS::out) is det :-
- (
+ %
+ list.foldl((pred(Var::in, !.SS::in, !:SS::out) is det :-
map.lookup(VarTypes, Var, Type),
map.lookup(NewMap1, Var, NewSelSet),
map.lookup(OldMap1, Var, OldSelSet),
SharingPairs = selector_sharing_set_altclos(ModuleInfo, ProcInfo,
Type, NewSelSet, OldSelSet),
- new_entries(ModuleInfo, ProcInfo, SharingPairs, SS0, SS)
- ),
- CommonVars,
- sharing_set_init,
- ResultSharingSet).
+ new_entries(ModuleInfo, ProcInfo, SharingPairs, !SS)
+ ), CommonVars, sharing_set_init, ResultSharingSet).
% sharing_set_altclos_3_directed(ModuleInfo, ProcInfo, NewSharingSet,
@@ -954,12 +968,12 @@
% As each and every pair within OldMapProjected needs to be looked at,
% we might as well use the full list representation:
OldSharingPairs = to_sharing_pair_list(OldSharingSetProjected),
-
+ %
% Now for each sharing pair X-Y represented by OldMapProjected, find
% all the datastructures in NewSharingMap that cover X, find
% all the datastructures in NewSharingMap that cover Y, and compute
% the crossproduct of both sets returning the set of new sharing pairs.
-
+ %
list.foldl(
pred(X - Y::in, SS0::in, SS::out) is det :-
(
@@ -988,7 +1002,7 @@
SharingSet2), to_sharing_pair_list(SharingSet1)).
sharing_set_least_upper_bound(ModuleInfo, ProcInfo, Set1, Set2) = Union :-
- % Foldling over the map could be done, but the union is easier to describe
+ % Folding over the map could be done, but the union is easier to describe
% by picking each of the sharing pairs represented by the smallest sharing
% set, and adding them to the other sharing set.
Set1 = sharing_set(Size1, _),
@@ -1021,6 +1035,7 @@
->
% The type of the variable is needed to be able to compare
% datastructures.
+ %
proc_info_vartypes(ProcInfo, VarTypes),
map.lookup(VarTypes, Var, VarType),
Datastructures = selector_sharing_set_extend_datastruct(ModuleInfo,
@@ -1036,7 +1051,6 @@
SharingMap0, SharingMap, 0, NewSize),
!:SharingSet = sharing_set(NewSize, SharingMap).
-
from_sharing_pair_list(SharingPairs) = SharingSet :-
list.foldl(new_entry_no_controls, SharingPairs, sharing_set_init,
SharingSet).
@@ -1051,8 +1065,10 @@
% XXX
% Due to the above checks, this operation may become quite costly. To
% verify!
-:- pred new_entry(module_info::in, proc_info::in,
- structure_sharing_pair::in, sharing_set::in, sharing_set::out) is det.
+ %
+:- pred new_entry(module_info::in, proc_info::in, structure_sharing_pair::in,
+ sharing_set::in, sharing_set::out) is det.
+
new_entry(ModuleInfo, ProcInfo, SharingPair0, !SharingSet) :-
% Normalize the sharing pair before doing anything.
SharingPair0 = DataX0 - DataY0,
@@ -1071,8 +1087,9 @@
new_entry_no_controls(SharingPair, !SharingSet)
).
-:- pred new_entry_no_controls(structure_sharing_pair::in, sharing_set::in,
- sharing_set::out) is det.
+:- pred new_entry_no_controls(structure_sharing_pair::in,
+ sharing_set::in, sharing_set::out) is det.
+
new_entry_no_controls(SharingPair, !SS) :-
SharingPair = Data1 - Data2,
new_directed_entry(Data1, Data2, !SS),
@@ -1086,14 +1103,17 @@
:- pred remove_entries(structure_sharing::in, sharing_set::in,
sharing_set::out) is det.
+
remove_entries(SharingPairs, !SS):-
list.foldl(remove_entry, SharingPairs, !SS).
% Remove a structure sharing pair that is known to be explicitly
% represented in the sharing set.
% Software error if the sharing pair is not part of the set.
-:- pred remove_entry(structure_sharing_pair::in, sharing_set::in,
- sharing_set::out) is det.
+ %
+:- pred remove_entry(structure_sharing_pair::in,
+ sharing_set::in, sharing_set::out) is det.
+
remove_entry(SharingPair, !SharingSet) :-
SharingPair = Data1 - Data2,
remove_directed_entry(Data1, Data2, !SharingSet),
@@ -1105,8 +1125,9 @@
remove_directed_entry(Data2, Data1, !SharingSet)
).
-:- pred remove_directed_entry(datastruct::in, datastruct::in, sharing_set::in,
- sharing_set::out) is det.
+:- pred remove_directed_entry(datastruct::in, datastruct::in,
+ sharing_set::in, sharing_set::out) is det.
+
remove_directed_entry(FromData, ToData, SharingSet0, SharingSet) :-
FromVar = FromData ^ sc_var,
FromSel = FromData ^ sc_selector,
@@ -1150,7 +1171,6 @@
unexpected(this_file, "Removing non-existant sharing pair.")
).
-
% Determine if the sharing set subsumes the sharing information
% represented by the structure sharing pair.
% This means: \exists A-B \in SharingSet, such that A-B is more general
@@ -1158,6 +1178,7 @@
%
:- pred sharing_set_subsumes_sharing_pair(module_info::in, proc_info::in,
sharing_set::in, structure_sharing_pair::in) is semidet.
+
sharing_set_subsumes_sharing_pair(ModuleInfo, ProcInfo, SharingSet,
SharingPair):-
SharingSet = sharing_set(_, SharingMap),
@@ -1203,9 +1224,11 @@
% Return the list of sharing pairs included in the sharing set that are
% less or equal to the given sharing pair.
+ %
:- pred sharing_set_subsumed_subset(module_info::in, proc_info::in,
- sharing_set::in, structure_sharing_pair::in,
- structure_sharing::out) is det.
+ sharing_set::in, structure_sharing_pair::in, structure_sharing::out)
+ is det.
+
sharing_set_subsumed_subset(ModuleInfo, ProcInfo, SharingSet, SharingPair,
SubsumedPairs) :-
SharingSet = sharing_set(_, SharingMap),
@@ -1224,12 +1247,12 @@
map.search(SharingMap, Var1, SelSharingSet)
->
SelSharingSet = selector_sharing_set(_, SelSharingMap),
-
+ %
% Determine all Selector-Dataset pairs where
% * Selector is less or equal to Sel1 wrt some extension E,
% * Dataset is a set of datastructures less or equal to Data2
% (wrt the same extension E).
-
+ %
map.keys(SelSharingMap, SelectorList),
list.filter_map(
pred(Selector::in, SPairs::out) is semidet :-
@@ -1259,15 +1282,17 @@
:- pred new_entries(module_info::in, proc_info::in, structure_sharing::in,
sharing_set::in, sharing_set::out) is det.
+
new_entries(ModuleInfo, ProcInfo, SharingPairs, !SS) :-
list.foldl(new_entry(ModuleInfo, ProcInfo), SharingPairs, !SS).
:- pred new_directed_entry(datastruct::in, datastruct::in,
sharing_set::in, sharing_set::out) is det.
+
new_directed_entry(FromData, ToData, SharingSet0, SharingSet):-
SharingSet0 = sharing_set(Size0, Map0),
- Var = FromData^sc_var,
- Selector = FromData^sc_selector,
+ Var = FromData ^ sc_var,
+ Selector = FromData ^ sc_selector,
(
map.search(Map0, Var, Selectors0)
->
@@ -1294,7 +1319,6 @@
),
SharingSet = sharing_set(Size, Map).
-
to_sharing_pair_list(SharingSet0) = SharingPairs :-
SharingSet = without_doubles(SharingSet0),
SharingSet = sharing_set(_, SharingMap),
@@ -1368,23 +1392,27 @@
Dataset = datastructures(_, Datastructures),
set.member(ToData, Datastructures).
-
-%-----------------------------------------------------------------------------%
-% selector_sharing_set predicates/functions.
%-----------------------------------------------------------------------------%
+%
+% selector_sharing_set predicates/functions
+%
+
:- func selector_sharing_set_init = selector_sharing_set.
+
:- pred selector_sharing_set_is_empty(selector_sharing_set::in) is semidet.
+
:- func selector_sharing_set_size(selector_sharing_set) = int.
:- pred selector_sharing_set_project(projection_type::in, prog_vars::in,
selector_sharing_set::in, selector_sharing_set::out) is det.
+
:- pred selector_sharing_set_rename(map(prog_var, prog_var)::in,
- tsubst::in, selector_sharing_set::in,
- selector_sharing_set::out) is det.
+ tsubst::in, selector_sharing_set::in, selector_sharing_set::out) is det.
% selector_sharing_set_new_entry(Selector, Datastruct, SS0, SS):
% Adds Datastruct into SS0 using Selector as a key. Fails if that
% Datastructs is already present with that selector.
+ %
:- pred selector_sharing_set_new_entry(selector::in, datastruct::in,
selector_sharing_set::in, selector_sharing_set::out) is semidet.
@@ -1398,7 +1426,6 @@
prog_var::in, selector_sharing_set::in, selector_sharing_set::out,
int::in, int::out) is det.
-
selector_sharing_set_init = selector_sharing_set(0, map.init).
selector_sharing_set_is_empty(selector_sharing_set(0, _Map)).
selector_sharing_set_size(selector_sharing_set(Size,_)) = Size.
@@ -1435,10 +1462,11 @@
:- pred selector_sharing_set_rename_2(map(prog_var, prog_var)::in,
tsubst::in, selector::in, data_set::in,
map(selector, data_set)::in, map(selector, data_set)::out) is det.
+
selector_sharing_set_rename_2(Dict, Subst, Selector0, DataSet0, !Map) :-
- prog_ctgc.rename_selector(Subst, Selector0, Selector),
+ rename_selector(Subst, Selector0, Selector),
data_set_rename(Dict, Subst, DataSet0, DataSet),
- map.det_insert(!.Map, Selector, DataSet, !:Map).
+ svmap.det_insert(Selector, DataSet, !Map).
selector_sharing_set_new_entry(Selector, Datastruct, SelSharingSet0,
SelSharingSet) :-
@@ -1461,20 +1489,21 @@
NewSelSet = selector_sharing_set(_, NewMap),
OldSelSet = selector_sharing_set(_, OldMap),
-
- % get the selectors
+ %
+ % Get the selectors.
+ %
map.keys(NewMap, NewSelectors),
map.keys(OldMap, OldSelectors),
-
- % for each selector in NewSelectors, verify each selector in OldSelector,
+ %
+ % For each selector in NewSelectors, verify each selector in OldSelector,
% if either one is less or equal to the other, then generate the structure
% sharing pair as appropriate.
+ %
NewSharingPairs = list.condense(list.map(
selector_sharing_set_altclos_2(ModuleInfo, ProcInfo, Type, NewMap,
OldMap, OldSelectors),
NewSelectors)).
-
:- func selector_sharing_set_altclos_2(module_info, proc_info, mer_type,
map(selector, data_set), map(selector, data_set), list(selector),
selector) = structure_sharing.
@@ -1513,7 +1542,6 @@
data_set_termshift(OldDataSet, Extension, TermShiftedOldDataSet),
SharingPairs = data_set_directed_closure(TermShiftedOldDataSet,
NewDataSet)
-
;
% OldSel <= NewSel ie, \exists Extension: NewSel.Extension = OldSel.
selector.subsumed_by(ModuleInfo, OldSel, NewSel, Type, Extension)
@@ -1594,27 +1622,31 @@
DataSetFinal = data_set_least_upper_bound(ModuleInfo, ProcInfo,
DataSet1, ExistingDataSet),
DataSetFinalSize = data_set_size(DataSetFinal),
- map.det_update(!.DataMap, NewSelector, DataSetFinal, !:DataMap),
+ svmap.det_update(NewSelector, DataSetFinal, !DataMap),
!:DataMapSize = !.DataMapSize - ExistingDataSetSize +
DataSetFinalSize
;
- map.det_insert(!.DataMap, NewSelector, DataSet1, !:DataMap),
+ svmap.det_insert(NewSelector, DataSet1, !DataMap),
!:DataMapSize = !.DataMapSize + data_set_size(DataSet1)
).
%-----------------------------------------------------------------------------%
-% data_set predicates/functions.
-%-----------------------------------------------------------------------------%
+%
+% data_set predicates/functions
+%
:- func data_set_init = data_set.
+
:- pred data_set_is_empty(data_set::in) is semidet.
+
:- func data_set_size(data_set) = int.
-:- pred data_set_project(projection_type::in, prog_vars::in, data_set::in,
- data_set::out) is det.
-:- pred data_set_rename(map(prog_var, prog_var)::in,
- tsubst::in,
+:- pred data_set_project(projection_type::in, prog_vars::in,
data_set::in, data_set::out) is det.
+
+:- pred data_set_rename(map(prog_var, prog_var)::in,
+ tsubst::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_new_entry(datastruct::in, data_set::in, data_set::out)
@@ -1629,28 +1661,27 @@
data_set) = data_set.
data_set_init = datastructures(0, set.init).
+
data_set_is_empty(datastructures(0, _Set)).
+
data_set_size(datastructures(Size, _)) = Size.
-data_set_project(ProjectionType, Vars, DataSet0, DataSet) :-
- data_set_filter(
- pred(Data::in) is semidet :-
- (
- Var = Data^sc_var,
+
+data_set_project(ProjectionType, Vars, !DataSet) :-
+ FilterData = (pred(Data::in) is semidet :-
+ Var = Data ^ sc_var,
(
ProjectionType = inproject,
list.member(Var, Vars)
;
ProjectionType = outproject,
- \+ list.member(Var, Vars)
+ not list.member(Var, Vars)
)
),
- DataSet0,
- DataSet).
+ data_set_filter(FilterData, !DataSet).
data_set_rename(Dict, Subst, !DataSet) :-
!.DataSet = datastructures(_Size, Datastructs0),
- Datastructs = set.map(prog_ctgc.rename_datastruct(Dict, Subst),
- Datastructs0),
+ Datastructs = set.map(rename_datastruct(Dict, Subst), Datastructs0),
!:DataSet = datastructures(set.count(Datastructs), Datastructs).
data_set_termshift(DataSet0, Selector, DataSet) :-
@@ -1675,17 +1706,15 @@
set(pair(T1, T2))::out) is det.
set_cross_product(Set0, Set1, CrossProduct):-
- solutions_set(
- pred(Pair::out) is nondet :-
- (
+ solutions_set((pred(Pair::out) is nondet :-
set.member(Elem0, Set0),
set.member(Elem1, Set1),
Pair = Elem0 - Elem1
- ),
- CrossProduct).
+ ), CrossProduct).
+
+:- pred data_set_filter(pred(datastruct)::in(pred(in) is semidet),
+ data_set::in, data_set::out) is det.
-:- 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, !DataSet) :-
!.DataSet = datastructures(_, Datastructs0),
Datastructs = set.filter(Pred, Datastructs0),
@@ -1695,16 +1724,16 @@
DataSet2) = DataSet :-
DataSet1 = datastructures(_, Datastructs1),
DataSet2 = datastructures(_, Datastructs2),
- set.fold(
- data_set_add_datastruct(ModuleInfo, ProcInfo),
+ set.fold(data_set_add_datastruct(ModuleInfo, ProcInfo),
Datastructs1, Datastructs2, Datastructs),
DataSet = datastructures(set.count(Datastructs), Datastructs).
:- pred data_set_add_datastruct(module_info::in, proc_info::in,
datastruct::in, set(datastruct)::in, set(datastruct)::out) is det.
+
data_set_add_datastruct(ModuleInfo, ProcInfo, Data, !Datastructs) :-
(
- % Perform the simple check of exact occurence in the set first...
+ % Perform the simple check of exact occurrence in the set first...
set.member(Data, !.Datastructs)
->
true
@@ -1714,7 +1743,7 @@
->
true
;
- set.insert(!.Datastructs, Data, !:Datastructs)
+ svset.insert(Data, !Datastructs)
).
% XXX ProcInfo could be replaced by a mercury type, as all the datastructures
@@ -1723,20 +1752,23 @@
% datastruct).
data_set_apply_widening(ModuleInfo, ProcInfo, !DataSet):-
!.DataSet = datastructures(_, Datastructs0),
- set.fold(
- data_set_widen_and_add(ModuleInfo, ProcInfo),
+ set.fold(data_set_widen_and_add(ModuleInfo, ProcInfo),
Datastructs0, set.init, Datastructs),
!:DataSet = datastructures(set.count(Datastructs), Datastructs).
:- pred data_set_widen_and_add(module_info::in, proc_info::in, datastruct::in,
set(datastruct)::in, set(datastruct)::out) is det.
+
data_set_widen_and_add(ModuleInfo, ProcInfo, Data0, !Datastructs):-
- ctgc.datastruct.apply_widening(ModuleInfo, ProcInfo, Data0, Data),
+ datastruct.apply_widening(ModuleInfo, ProcInfo, Data0, Data),
data_set_add_datastruct(ModuleInfo, ProcInfo, Data, !Datastructs).
%-----------------------------------------------------------------------------%
+
:- func this_file = string.
this_file = "structure_sharing.domain.m".
+
+%-----------------------------------------------------------------------------%
+:- end_module structure_sharing.domain.
%-----------------------------------------------------------------------------%
-:- end_module transform_hlds.ctgc.structure_sharing.domain.
Index: compiler/structure_sharing.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/structure_sharing.m,v
retrieving revision 1.2
diff -u -b -r1.2 structure_sharing.m
--- compiler/structure_sharing.m 22 Feb 2006 08:05:17 -0000 1.2
+++ compiler/structure_sharing.m 23 Feb 2006 07:58:37 -0000
@@ -1,19 +1,20 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 2005-2006 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.
%-----------------------------------------------------------------------------%
-%
-% File: structure_sharing.m
-% Main author: nancy
-%
+
+% File: structure_sharing.m.
+% Main author: nancy.
+
% Package grouping all the modules related to the data structure sharing
% analysis needed for data structure reuse.
-%
+
%-----------------------------------------------------------------------------%
:- module transform_hlds.ctgc.structure_sharing.
-
:- interface.
:- include_module analysis.
@@ -25,4 +26,6 @@
% This explains the import of ll_backend here.
:- import_module ll_backend.
+%-----------------------------------------------------------------------------%
:- end_module transform_hlds.ctgc.structure_sharing.
+%-----------------------------------------------------------------------------%
--------------------------------------------------------------------------
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