[m-rev.] diff: more cleanups of ctgc
Zoltan Somogyi
zs at cs.mu.OZ.AU
Tue Feb 28 17:12:23 AEDT 2006
compiler/*ctgc*.m:
compiler/structure_sharing*.m:
Further cleanups, mostly renaming predicates with ambiguous names,
and turning some lambda expressions into named predicates.
Zoltan.
cvs diff: Diffing .
Index: ctgc.datastruct.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ctgc.datastruct.m,v
retrieving revision 1.2
diff -u -b -r1.2 ctgc.datastruct.m
--- ctgc.datastruct.m 27 Feb 2006 08:05:19 -0000 1.2
+++ ctgc.datastruct.m 28 Feb 2006 05:54:36 -0000
@@ -27,21 +27,21 @@
% Create an initial top-datastruct of the given variable.
%
-:- func init(prog_var) = datastruct.
-:- func init(prog_var, selector) = datastruct.
-:- func init(prog_var, cons_id, int) = datastruct.
+:- func datastruct_init(prog_var) = datastruct.
+:- func datastruct_init_with_selector(prog_var, selector) = datastruct.
+:- func datastruct_init_with_pos(prog_var, cons_id, int) = datastruct.
- % Verify whether the given datastructs are idenitical.
+ % Verify whether the given datastructs are identical.
%
-:- pred equal(datastruct::in, datastruct::in) is semidet.
+:- pred datastruct_equal(datastruct::in, datastruct::in) is semidet.
- % Select a subterm of the given datastructure using the specified
- % selector.
+ % Select a subterm of the given datastructure using the specified selector.
% It is assumed that the selector is a valid selector for that
% datastructure.
%
-:- pred termshift(selector::in, datastruct::in, datastruct::out) is det.
-:- func termshift(selector, datastruct) = datastruct.
+:- pred datastruct_termshift(selector::in, datastruct::in, datastruct::out)
+ is det.
+:- func datastruct_termshift(selector, datastruct) = datastruct.
% Normalize the representation of the datastructure.
% (proc_info is needed to obtain the type of the variable of the
@@ -50,25 +50,25 @@
% iff none of the term nodes met on the path to the actual selected
% term by the selector has the same type as the selected node.
%
-:- func normalize(module_info, proc_info, datastruct) = datastruct.
+:- func normalize_datastruct(module_info, proc_info, datastruct) = datastruct.
% Normalize the representation of the datastructure using its
% type information.
%
-:- pred normalize_with_type_information(module_info::in, mer_type::in,
+:- pred normalize_datastruct_with_type_information(module_info::in, mer_type::in,
datastruct::in, datastruct::out) is det.
-:- func normalize_with_type_information(module_info, mer_type,
+:- func normalize_datastruct_with_type_information(module_info, mer_type,
datastruct) = datastruct.
-:- pred subsumed_by(module_info::in, proc_info::in, datastruct::in,
- datastruct::in, selector::out) is semidet.
-:- pred subsumed_by(module_info::in, proc_info::in, datastruct::in,
- datastruct::in) is semidet.
-:- pred subsumed_by_list(module_info::in, proc_info::in, datastruct::in,
- list(datastruct)::in) is semidet.
+:- pred datastruct_subsumed_by_return_selector(module_info::in, proc_info::in,
+ datastruct::in, datastruct::in, selector::out) is semidet.
+:- pred datastruct_subsumed_by(module_info::in, proc_info::in,
+ datastruct::in, datastruct::in) is semidet.
+:- pred datastruct_subsumed_by_list(module_info::in, proc_info::in,
+ datastruct::in, list(datastruct)::in) is semidet.
-:- pred apply_widening(module_info::in, proc_info::in, datastruct::in,
- datastruct::out) is det.
+:- pred datastruct_apply_widening(module_info::in, proc_info::in,
+ datastruct::in, datastruct::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -81,34 +81,37 @@
%-----------------------------------------------------------------------------%
-init(V) = init(V, []).
-init(V, Sel) = selected_cel(V, Sel).
-init(V, ConsId, Int) = init(V, selector.init(ConsId, Int)).
+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)).
-equal(D1, D2) :- D1 = D2.
+datastruct_equal(D1, D2) :- D1 = D2.
-termshift(Sel, Data0, Data) :-
+datastruct_termshift(Sel, Data0, Data) :-
DSel = Data0 ^ sc_selector,
- selector.termshift(DSel, Sel, NewSel),
+ selector_termshift(DSel, Sel, NewSel),
Data = Data0 ^ sc_selector := NewSel.
-termshift(Sel, Data0) = Data :-
- termshift(Sel, Data0, Data).
-normalize_with_type_information(ModuleInfo, Type, !Datastruct) :-
+datastruct_termshift(Sel, Data0) = Data :-
+ datastruct_termshift(Sel, Data0, Data).
+
+normalize_datastruct_with_type_information(ModuleInfo, Type, !Datastruct) :-
DSel0 = !.Datastruct ^ sc_selector,
- normalize_with_type_information(ModuleInfo, Type, DSel0, DSel),
+ normalize_selector_with_type_information(ModuleInfo, Type, DSel0, DSel),
!:Datastruct = !.Datastruct ^ sc_selector := DSel.
-normalize_with_type_information(ModuleInfo, Type, Data0) = Data :-
- normalize_with_type_information(ModuleInfo, Type, Data0, Data).
+normalize_datastruct_with_type_information(ModuleInfo, Type, Data0) = Data :-
+ normalize_datastruct_with_type_information(ModuleInfo, Type, Data0, Data).
-normalize(ModuleInfo, ProcInfo, Data0) = Data :-
+normalize_datastruct(ModuleInfo, ProcInfo, Data0) = Data :-
Var = Data0 ^ sc_var,
proc_info_vartypes(ProcInfo, VarTypes),
map.lookup(VarTypes, Var, Type),
- Data = normalize_with_type_information(ModuleInfo, Type, Data0).
+ Data = normalize_datastruct_with_type_information(ModuleInfo, Type, Data0).
-subsumed_by(ModuleInfo, ProcInfo, Data1, Data2, Extension) :-
+datastruct_subsumed_by_return_selector(ModuleInfo, ProcInfo, Data1, Data2,
+ Extension) :-
Var = Data1 ^ sc_var,
Var = Data2 ^ sc_var,
Sel1 = Data1 ^ sc_selector,
@@ -117,23 +120,24 @@
map.lookup(VarTypes, Var, Type),
ctgc.selector.subsumed_by(ModuleInfo, Sel1, Sel2, Type, Extension).
-subsumed_by(ModuleInfo, ProcInfo, Data1, Data2) :-
- subsumed_by(ModuleInfo, ProcInfo, Data1, Data2, _).
+datastruct_subsumed_by(ModuleInfo, ProcInfo, Data1, Data2) :-
+ datastruct_subsumed_by_return_selector(ModuleInfo, ProcInfo, Data1, Data2,
+ _).
-subsumed_by_list(ModuleInfo, ProcInfo, Data0, [Data|Rest]):-
+datastruct_subsumed_by_list(ModuleInfo, ProcInfo, Data0, [Data | Rest]):-
(
- subsumed_by(ModuleInfo, ProcInfo, Data0, Data)
+ datastruct_subsumed_by(ModuleInfo, ProcInfo, Data0, Data)
;
- subsumed_by_list(ModuleInfo, ProcInfo, Data0, Rest)
+ datastruct_subsumed_by_list(ModuleInfo, ProcInfo, Data0, Rest)
).
-apply_widening(ModuleInfo, ProcInfo, !Data) :-
+datastruct_apply_widening(ModuleInfo, ProcInfo, !Data) :-
Var = !.Data ^ sc_var,
Sel0 = !.Data ^ sc_selector,
proc_info_vartypes(ProcInfo, VarTypes),
map.lookup(VarTypes, Var, Type),
- apply_widening(ModuleInfo, Type, Sel0, Sel),
- !:Data = init(Var, Sel).
+ selector_apply_widening(ModuleInfo, Type, Sel0, Sel),
+ !:Data = datastruct_init_with_selector(Var, Sel).
%-----------------------------------------------------------------------------%
:- end_module transform_hlds.ctgc.datastruct.
Index: ctgc.fixpoint_table.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ctgc.fixpoint_table.m,v
retrieving revision 1.2
diff -u -b -r1.2 ctgc.fixpoint_table.m
--- ctgc.fixpoint_table.m 27 Feb 2006 08:05:20 -0000 1.2
+++ ctgc.fixpoint_table.m 28 Feb 2006 05:26:36 -0000
@@ -26,7 +26,7 @@
% 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).
+:- func init_fixpoint_table(func(K) = E, list(K)) = fixpoint_table(K, E).
% Inform the table that a new run has begun.
%
@@ -46,21 +46,23 @@
% Check whether the entries are recursive.
%
-:- pred is_recursive(fixpoint_table(K,E)::in) is semidet.
+:- pred is_recursive(fixpoint_table(K, E)::in) is semidet.
+ % add_to_fixpoint_table(EqualityTest, Key, Element, !Table):
+ %
% Add a new element (E) associated with key (K) to the table.
- % - if an element is already recorded with that key:
+ %
+ % - If an element is already recorded with that key:
% * if the new value is subsumed by the existing value, then
- % a fixpoint is obtained as far as this key is concerned.
+ % a fixpoint is obtained as far as this key is concerned;
% * if the values are different, fixpoint is not reached yet,
% and the new value is recorded instead of the old one.
- % - if the key has not yet any value associated to it, add it
- % to the table (which does not change the stability of the
- % table)
- % add( EqualityTest, Key, Element, TableIn, TableOut).
%
-:- pred add(pred(E, E), K, E, fixpoint_table(K, E), fixpoint_table(K, E)).
-:- mode add(pred(in, in) is semidet, in, in, in, out) is det.
+ % - If the key has not yet any value associated to it, add it
+ % to the table (which does not change the stability of the table)
+ %
+:- pred add_to_fixpoint_table(pred(E, E)::in(pred(in, in) is semidet),
+ K::in, E::in, fixpoint_table(K, E)::in, fixpoint_table(K, E)::out) is det.
% Retrieve an element E associated with key K from the table.
% This operation changes the state of the table if the
@@ -68,19 +70,19 @@
% a recursive calltree. If the key is not an element of the
% allowed keys, then the procedure fails.
%
-:- pred get(K::in, E::out, fixpoint_table(K, E)::in,
- fixpoint_table(K, E)::out) is semidet.
+:- pred get_from_fixpoint_table(K::in, E::out,
+ fixpoint_table(K, E)::in, fixpoint_table(K, E)::out) is semidet.
% Retrieve an element E associated with key K from the table.
- % The operation reports a software error when the element is not
- % present.
+ % The operation reports a software error when the element is not present.
%
-:- func get_final(K, fixpoint_table(K,E)) = E.
+:- func get_from_fixpoint_table_final(K, fixpoint_table(K, E)) = E.
% Same as get_final, but the predicate fails instead of aborting when
% the element is not present.
%
-:- func get_final_semidet(K, fixpoint_table(K,E)) = E is semidet.
+:- func get_from_fixpoint_table_final_semidet(K, fixpoint_table(K, E)) = E
+ is semidet.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -99,65 +101,70 @@
%-----------------------------------------------------------------------------%
:- type fixpoint_table(K, E)
- ---> ft(
+ ---> fixpoint_table(
keys :: list(K), % list of allowed keys
run :: int, % number of runs
- recursive :: bool, % is recursive or not
+ recursive :: is_recursive,
mapping :: map(K, fp_entry(E))
).
:- type fp_entry(E)
---> entry(
- bool, % stability: yes = stable, no = unstable
- E
+ entry_stable :: is_stable,
+ entry_elem :: E
).
+:- type is_recursive
+ ---> is_recursive
+ ; is_not_recursive.
+
+:- type is_stable
+ ---> is_stable
+ ; is_unstable.
+
%-----------------------------------------------------------------------------%
:- 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.
-fp_entry_elem(entry(_, Elem)) = Elem.
+:- func fp_entry_init_with_stability(is_stable, E) = fp_entry(E).
-init(InitFunction, Ks) = ft(Ks, Run, IsRecursive, Map) :-
- Run = 0,
- IsRecursive = no,
+fp_entry_init(Elem) = entry(is_unstable, Elem).
+fp_entry_init_with_stability(IsStable, Elem) = entry(IsStable, Elem).
+
+init_fixpoint_table(InitFunction, Ks) = FT :-
InsertElement = (pred(K::in, !.Map::in, !:Map::out) is det :-
E = InitFunction(K),
svmap.det_insert(K, fp_entry_init(E), !Map)
),
- list.foldl(InsertElement, Ks, map.init, Map).
+ list.foldl(InsertElement, Ks, map.init, Map),
+ Run = 0,
+ FT = fixpoint_table(Ks, Run, is_not_recursive, Map).
new_run(T0, T0 ^ run := T0 ^ run + 1).
which_run(T0) = T0 ^ run.
-is_recursive(T) :- T ^ recursive = yes.
+is_recursive(T) :- T ^ recursive = is_recursive.
fixpoint_reached(T) :-
+ IsRecursive = T ^ recursive,
(
- T ^ recursive = yes
- ->
- map__foldl(
- pred(_K::in, Entry::in, S0::in, S::out) is det :-
- (
- (
- S0 = no,
- S = no
+ IsRecursive = is_recursive,
+ map.foldl(accumulate_instability, T ^ mapping,
+ is_stable, FinalStability),
+ FinalStability = is_stable
;
- S0 = yes,
- S = fp_entry_stability(Entry)
- )
- ),
- T ^ mapping,
- yes,
- yes)
+ IsRecursive = is_not_recursive
+ ).
+
+:- pred accumulate_instability(K::in, fp_entry(E)::in,
+ is_stable::in, is_stable::out) is det.
+
+accumulate_instability(_Key, Entry, S0, S) :-
+ (
+ S0 = is_unstable,
+ S = is_unstable
;
- true
+ S0 = is_stable,
+ S = Entry ^ entry_stable
).
description(T) =
@@ -167,17 +174,14 @@
"unstable"
).
-
-add(IsLessOrEqualTest, Index, Elem, Tin, Tout) :-
- Map = Tin ^ mapping,
- map__lookup(Map, Index, Entry),
- TabledElem = fp_entry_elem(Entry),
- (
- IsLessOrEqualTest(Elem, TabledElem)
- ->
- S = yes
+add_to_fixpoint_table(IsLessOrEqualTest, Index, Elem, !T) :-
+ Map0 = !.T ^ mapping,
+ map.lookup(Map0, Index, Entry),
+ TabledElem = Entry ^ entry_elem,
+ ( IsLessOrEqualTest(Elem, TabledElem) ->
+ IsStable = is_stable
;
- S = no
+ IsStable = is_unstable
),
%
% Whether or not the tabled element is equal to the new element, the final
@@ -189,31 +193,28 @@
% 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).
-
-get(Index, Elem, Tin, Tout) :-
- List = Tin ^ keys,
- list__member(Index, List), % can fail
- Mapin = Tin ^ mapping,
- map__lookup(Mapin, Index, Entry),
- Elem = fp_entry_elem(Entry),
- Mapout = Mapin,
- Tout = (Tin ^ mapping := Mapout) ^ recursive := yes.
+ FinalTabledElem = fp_entry_init_with_stability(IsStable, Elem),
+ map.det_update(Map0, Index, FinalTabledElem, Map),
+ !:T = !.T ^ mapping := Map.
+
+get_from_fixpoint_table(Index, Elem, !T) :-
+ List = !.T ^ keys,
+ list.member(Index, List), % can fail
+ Map = !.T ^ mapping,
+ map.lookup(Map, Index, Entry),
+ Elem = Entry ^ entry_elem,
+ !:T = !.T ^ recursive := is_recursive.
-get_final(Index, T) = Elem :-
- (
- TabledElem = get_final_semidet(Index, T)
- ->
+get_from_fixpoint_table_final(Index, T) = Elem :-
+ ( TabledElem = get_from_fixpoint_table_final_semidet(Index, T) ->
Elem = TabledElem
;
unexpected(this_file, "get_final: key not in map.")
).
-get_final_semidet(Index, T) = Elem :-
- map__search(T ^ mapping, Index, Entry),
- Elem = fp_entry_elem(Entry).
+get_from_fixpoint_table_final_semidet(Index, T) = Elem :-
+ map.search(T ^ mapping, Index, Entry),
+ Elem = Entry ^ entry_elem.
%-----------------------------------------------------------------------------%
Index: ctgc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ctgc.m,v
retrieving revision 1.3
diff -u -b -r1.3 ctgc.m
Index: ctgc.selector.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ctgc.selector.m,v
retrieving revision 1.2
diff -u -b -r1.2 ctgc.selector.m
--- ctgc.selector.m 27 Feb 2006 08:05:20 -0000 1.2
+++ ctgc.selector.m 28 Feb 2006 05:53:41 -0000
@@ -27,12 +27,12 @@
% or a type selector.
%
:- func top_selector = selector.
-:- func init(cons_id, int) = selector.
-:- func init(list(mer_type)) = selector.
+:- func selector_init(cons_id, int) = selector.
+:- func selector_init_from_list(list(mer_type)) = selector.
% Perform a termshift operation.
%
-:- pred termshift(selector::in, selector::in, selector::out) is det.
+:- pred selector_termshift(selector::in, selector::in, selector::out) is det.
% subsumed_by(ModuleInfo, Selector0, Selector1, Type, Extension).
%
@@ -40,8 +40,7 @@
% Selector1 is more general than Selector0, hence, there exists an
% extension Ext, such that Selector1.Extension = Selector0.
%
- % NOTE: the type specifies the type of the term to which the selectors
- % refer.
+ % The type specifies the type of the term to which the selectors refer.
%
:- pred subsumed_by(module_info::in, selector::in, selector::in,
mer_type::in, selector::out) is semidet.
@@ -52,7 +51,7 @@
% * type of the node selected by S2 = type of the node selected by S1.
% * a path of selectors can be constructed which leads from S2 to S1.
%
-:- pred normalize_with_type_information(module_info::in, mer_type::in,
+:- pred normalize_selector_with_type_information(module_info::in, mer_type::in,
selector::in, selector::out) is det.
% SubType = type_of_node(ModuleInfo, StartType, Selector).
@@ -63,7 +62,7 @@
% Abbreviate a selector to the type of the node it selects.
%
-:- pred apply_widening(module_info::in, mer_type::in,
+:- pred selector_apply_widening(module_info::in, mer_type::in,
selector::in, selector::out) is det.
%-----------------------------------------------------------------------------%
@@ -84,16 +83,17 @@
%-----------------------------------------------------------------------------%
top_selector = [].
-init(Cons, Index) = [termsel(Cons, Index)].
-init(Types) =
- list.map(func(T) = US :- US = typesel(T), Types).
-termshift(S1, S2, S) :- list.append(S1, S2, S).
+selector_init(Cons, Index) = [termsel(Cons, Index)].
+selector_init_from_list(Types)
+ = list.map(func(T) = US :- US = typesel(T), Types).
+
+selector_termshift(S1, S2, S) :- list.append(S1, S2, S).
subsumed_by(ModuleInfo, S1, S2, MainType, Extension):-
- % first make sure that both selectors are in a normalized form.
- normalize_with_type_information(ModuleInfo, MainType, S1, NormS1),
- normalize_with_type_information(ModuleInfo, MainType, S2, NormS2),
+ % First make sure that both selectors are in a normalized form.
+ normalize_selector_with_type_information(ModuleInfo, MainType, S1, NormS1),
+ normalize_selector_with_type_information(ModuleInfo, MainType, S2, NormS2),
subsumed_by_2(ModuleInfo, NormS1, NormS2, MainType, Extension).
:- pred subsumed_by_2(module_info::in, selector::in, selector::in,
@@ -126,17 +126,18 @@
% 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)
+ selector_subsumed_by(S1, S2, Extension)
).
-:- pred subsumed_by(selector::in, selector::in, selector::out) is semidet.
+:- pred selector_subsumed_by(selector::in, selector::in, selector::out)
+ is semidet.
-subsumed_by(S1, S2, Extension):-
+selector_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)
@@ -158,12 +159,10 @@
select_subtype(ModuleInfo, Type, ConsID, Choice) = SubType :-
(
- get_cons_id_non_existential_arg_types(ModuleInfo,
- Type, ConsID, ArgTypes)
- ->
- (
- list.index1(ArgTypes, Choice, SubType0)
+ get_cons_id_non_existential_arg_types(ModuleInfo, Type, ConsID,
+ ArgTypes)
->
+ ( list.index1(ArgTypes, Choice, SubType0) ->
SubType = SubType0
;
unexpected(this_file, "get_type_of_node: selection failed.")
@@ -183,7 +182,7 @@
split_upto_type_selector(Sin, S1, TS, S2):-
list.takewhile(is_term_selector, Sin, S1, Remainder),
- Remainder = [TS | S2 ].
+ Remainder = [TS | S2].
:- pred is_term_selector(unit_selector::in) is semidet.
@@ -234,12 +233,10 @@
->
RemainderPath = Path
;
- Path = [ UnitSelector | Rest ],
+ Path = [UnitSelector | Rest],
(
UnitSelector = typesel(SubType),
- (
- SubType = ToType
- ->
+ ( SubType = ToType ->
(
% Check if the same type occurs anywhere further on the
% path.
@@ -257,9 +254,7 @@
;
UnitSelector = termsel(ConsId, Index),
SubType = select_subtype(ModuleInfo, FromType, ConsId, Index),
- (
- SubType = ToType
- ->
+ ( SubType = ToType ->
(
% Check if the same type occurs anywhere further on the
% path.
@@ -277,27 +272,25 @@
)
).
-normalize_with_type_information(ModuleInfo, Type, !Selector) :-
- (
- is_introduced_type_info_type(Type)
- ->
+normalize_selector_with_type_information(ModuleInfo, Type, !Selector) :-
+ ( is_introduced_type_info_type(Type) ->
true
;
branch_map_init(BranchMap0),
branch_map_insert(Type, top_selector, BranchMap0, BranchMap1),
- normalize_wti(ModuleInfo, Type, BranchMap1, top_selector, !Selector)
+ do_normalize_selector(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.
+:- pred do_normalize_selector(module_info::in, mer_type::in,
+ branch_map::in, selector::in, selector::in, selector::out) is det.
-normalize_wti(ModuleInfo, VarType, BranchMap0, SelectorAcc0, !Selector) :-
+do_normalize_selector(ModuleInfo, VarType, BranchMap0,
+ SelectorAcc0, !Selector) :-
(
!.Selector = [ UnitSelector | SelRest ],
Class = classify_type(ModuleInfo, VarType),
- (
- Class = type_cat_user_ctor
- ->
+ ( Class = type_cat_user_ctor ->
% If it is either a term-selector of a non existentially typed
% functor or a type-selector, construct the branch map and proceed
% with normalization. If it is a term-selector of an existentially
@@ -307,9 +300,7 @@
UnitSelector = termsel(ConsId, Index),
get_cons_id_non_existential_arg_types(ModuleInfo,
VarType, ConsId, ArgTypes),
- (
- list.index1(ArgTypes, Index, SubType)
- ->
+ ( list.index1(ArgTypes, Index, SubType) ->
CType = SubType
;
unexpected(this_file, "normalize_wti: " ++
@@ -320,26 +311,23 @@
)
->
!:Selector = SelRest,
- (
- branch_map_search(BranchMap0, CType,
- BranchSelector)
- ->
- normalize_wti(ModuleInfo, CType,
- BranchMap0, BranchSelector, !Selector)
+ ( branch_map_search(BranchMap0, CType, BranchSelector) ->
+ do_normalize_selector(ModuleInfo, CType, BranchMap0,
+ BranchSelector, !Selector)
;
- termshift(SelectorAcc0, [UnitSelector],
+ selector_termshift(SelectorAcc0, [UnitSelector],
SelectorAcc1),
- branch_map_insert(CType,
- SelectorAcc1, BranchMap0, BranchMap1),
- normalize_wti(ModuleInfo, CType,
- BranchMap1, SelectorAcc1, !Selector)
+ branch_map_insert(CType, SelectorAcc1,
+ BranchMap0, BranchMap1),
+ do_normalize_selector(ModuleInfo, CType, BranchMap1,
+ SelectorAcc1, !Selector)
)
;
- % existentially typed functor.
+ % Existentially typed functor.
append(SelectorAcc0, !Selector)
)
;
- % if it is not a user type, SelRest is empty anyhow, and
+ % If it is not a user type, SelRest is empty anyhow, and
% normalization stops.
% Resulting selector = accumulator.sel0
append(SelectorAcc0, !Selector)
@@ -349,11 +337,11 @@
!:Selector = SelectorAcc0
).
-apply_widening(ModuleInfo, MainType, !Selector) :-
+selector_apply_widening(ModuleInfo, MainType, !Selector) :-
(
!.Selector = []
;
- !.Selector = [_|_],
+ !.Selector = [_ | _],
UnitSelector = typesel(type_of_node(ModuleInfo, MainType, !.Selector)),
!:Selector = [UnitSelector]
).
@@ -367,27 +355,27 @@
:- pred branch_map_init(branch_map::out) is det.
-:- pred branch_map_insert(mer_type::in, selector::in, branch_map::in,
- branch_map::out) is det.
+branch_map_init([]).
-:- pred branch_map_search(branch_map::in, mer_type::in,
- selector::out) is semidet.
+:- pred branch_map_insert(mer_type::in, selector::in,
+ branch_map::in, branch_map::out) is det.
-branch_map_init([]).
+branch_map_insert(Type, Sel, TypeSels, [Type - Sel | TypeSels]).
-branch_map_insert(Type, SelPart, Map1, [(Type - SelPart) | Map1]).
+:- pred branch_map_search(branch_map::in, mer_type::in, selector::out)
+ is semidet.
-branch_map_search([ (T1 - S1) | Ms ], T2, S):-
+branch_map_search([Type - Sel | TypeSels], KeyType, ValueSel):-
map.init(Empty),
% The two types are considered equal if they unify under an
- % empty substitution
+ % empty substitution.
(
- type_unify(T1, T2, [], Empty, Subst),
+ type_unify(Type, KeyType, [], Empty, Subst),
map.is_empty(Subst)
->
- S = S1
+ ValueSel = Sel
;
- branch_map_search(Ms, T2, S)
+ branch_map_search(TypeSels, KeyType, ValueSel)
).
%-----------------------------------------------------------------------------%
Index: ctgc.util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ctgc.util.m,v
retrieving revision 1.2
diff -u -b -r1.2 ctgc.util.m
Index: layout_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/layout_out.m,v
retrieving revision 1.58
diff -u -b -r1.58 layout_out.m
--- layout_out.m 28 Nov 2005 04:11:43 -0000 1.58
+++ layout_out.m 28 Feb 2006 05:12:19 -0000
@@ -1146,9 +1146,7 @@
Origin = lambda(FileName0, LineNum, SeqNo),
( string__append("IntroducedFrom", _, Name0) ->
string__replace_all(FileName0, ".", "_", FileName),
- (
- SeqNo > 1
- ->
+ ( SeqNo > 1 ->
string__format("lambda%d_%s_%d",
[i(SeqNo), s(FileName), i(LineNum)], Name)
;
Index: prog_ctgc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_ctgc.m,v
retrieving revision 1.2
diff -u -b -r1.2 prog_ctgc.m
--- prog_ctgc.m 27 Feb 2006 08:05:20 -0000 1.2
+++ prog_ctgc.m 28 Feb 2006 05:19:18 -0000
@@ -67,13 +67,14 @@
% 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,
+:- pred print_structure_sharing_as_list(prog_varset::in, tvarset::in,
structure_sharing::in, io::di, io::uo) is det.
% Print structure sharing domain.
%
% print_structure_sharing_domain(P, T, VerboseTop, MaybeThreshold,
% Sharing, !IO):
+ %
% If VerboseTop = yes, then the full list of reasons why sharing is
% top is printed as "top([ ... Messages ... ])". If VerboseTop = no,
% then top is printed as "top".
@@ -356,15 +357,20 @@
),
io.write_string(End, !IO).
-print_structure_sharing(ProgVarSet, TypeVarSet, SharingPairs, !IO) :-
+print_structure_sharing_as_list(ProgVarSet, TypeVarSet, SharingPairs, !IO) :-
print_structure_sharing(ProgVarSet, TypeVarSet, no,
"[", ",", "]", SharingPairs, !IO).
-:- pred print_structure_sharing_domain(prog_varset::in, tvarset::in,
+print_structure_sharing_domain(ProgVarSet, TypeVarSet, VerboseTop,
+ MaybeThreshold, SharingAs, !IO) :-
+ do_print_structure_sharing_domain(ProgVarSet, TypeVarSet, VerboseTop,
+ MaybeThreshold, "", ",", "", SharingAs, !IO).
+
+:- pred do_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::di, io::uo) is det.
-print_structure_sharing_domain(ProgVarSet, TypeVarSet, VerboseTop,
+do_print_structure_sharing_domain(ProgVarSet, TypeVarSet, VerboseTop,
MaybeThreshold, Start, Separator, End, SharingAs, !IO) :-
io.write_string(Start, !IO),
(
@@ -389,16 +395,11 @@
),
io.write_string(End, !IO).
-print_structure_sharing_domain(ProgVarSet, TypeVarSet, VerboseTop,
- MaybeThreshold, SharingAs, !IO) :-
- print_structure_sharing_domain(ProgVarSet, TypeVarSet, VerboseTop,
- MaybeThreshold, "", ",", "", SharingAs, !IO).
-
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) :-
- print_structure_sharing_domain(ProgVarSet, TypeVarSet, yes,
+ do_print_structure_sharing_domain(ProgVarSet, TypeVarSet, yes,
no, "%\t ", "\n%\t", "\n", SharingAs, !IO).
print_interface_structure_sharing_domain(_, _, no, !IO) :-
Index: structure_sharing.analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_sharing.analysis.m,v
retrieving revision 1.5
diff -u -b -r1.5 structure_sharing.analysis.m
--- structure_sharing.analysis.m 27 Feb 2006 08:05:21 -0000 1.5
+++ structure_sharing.analysis.m 28 Feb 2006 05:52:24 -0000
@@ -64,7 +64,7 @@
%-----------------------------------------------------------------------------%
-structure_sharing_analysis(!ModuleInfo, SharingTable, !IO):-
+structure_sharing_analysis(!ModuleInfo, SharingTable, !IO) :-
% preliminary step:
% annotate the liveness (as in liveness.m)
annotate_liveness(!ModuleInfo, !IO),
@@ -98,7 +98,7 @@
:- 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.
-load_structure_sharing_table_3(ModuleInfo, PredId, ProcId, !SharingTable):-
+load_structure_sharing_table_3(ModuleInfo, PredId, ProcId, !SharingTable) :-
module_info_proc_info(ModuleInfo, PredId, ProcId, ProcInfo),
proc_info_get_structure_sharing(ProcInfo, MaybePublicSharing),
(
@@ -116,7 +116,7 @@
:- pred annotate_liveness(module_info::in, module_info::out, io::di,
io::uo) is det.
-annotate_liveness(!ModuleInfo, !IO):-
+annotate_liveness(!ModuleInfo, !IO) :-
process_all_nonimported_procs(update_proc_io(detect_liveness_proc),
!ModuleInfo, !IO).
@@ -125,7 +125,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_analysis(!ModuleInfo, !SharingTable, !IO):-
+sharing_analysis(!ModuleInfo, !SharingTable, !IO) :-
% Perform the analysis based on the strongly connected components.
module_info_ensure_dependency_info(!ModuleInfo),
module_info_get_maybe_dependency_info(!.ModuleInfo, MaybeDepInfo),
@@ -154,7 +154,7 @@
:- 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):-
+analyse_scc(ModuleInfo, SCC, !SharingTable, !IO) :-
( preds_requiring_no_analysis(ModuleInfo, SCC) ->
true
;
@@ -209,10 +209,8 @@
% In some cases the sharing can be predicted to be bottom, in which
% case a full sharing analysis is not needed.
- Sharing0 = structure_sharing.domain.init,
- (
- bottom_sharing_is_safe_approximation(ModuleInfo, ProcInfo)
- ->
+ Sharing0 = sharing_as_init,
+ ( bottom_sharing_is_safe_approximation(ModuleInfo, ProcInfo) ->
maybe_write_string(Verbose, "\t\t: bottom predicted", !IO),
Sharing = Sharing0
;
@@ -222,7 +220,7 @@
!FixpointTable, Sharing0, Sharing1, !IO),
FullAsDescr = short_description(Sharing1),
- structure_sharing.domain.project(HeadVars, Sharing1, Sharing2),
+ sharing_as_project(HeadVars, Sharing1, Sharing2),
ProjAsDescr = short_description(Sharing2),
structure_sharing.domain.apply_widening(ModuleInfo, ProcInfo,
@@ -247,13 +245,12 @@
!FixpointTable),
maybe_write_string(Verbose, "\t\t (ft = " ++
- ss_fixpoint_table_description(!.FixpointTable) ++
- ")\n", !IO).
+ ss_fixpoint_table_description(!.FixpointTable) ++ ")\n", !IO).
:- pred analyse_goal(module_info::in, pred_info::in, proc_info::in,
- sharing_as_table::in, hlds_goal::in, ss_fixpoint_table::in,
- ss_fixpoint_table::out, sharing_as::in, sharing_as::out,
- io::di, io::uo) is det.
+ sharing_as_table::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_goal(ModuleInfo, PredInfo, ProcInfo, SharingTable, Goal,
!FixpointTable, !SharingAs, !IO) :-
@@ -268,8 +265,8 @@
ConjType = parallel_conj,
goal_info_get_context(GoalInfo, Context),
context_to_string(Context, ContextString),
- !:SharingAs = top_sharing("par_conj (" ++ ContextString ++ ")",
- !.SharingAs)
+ !:SharingAs = sharing_as_top_sharing_accumulate(
+ "par_conj (" ++ ContextString ++ ")", !.SharingAs)
)
;
GoalExpr = call(CalleePredId, CalleeProcId, CalleeArgs, _, _, _),
@@ -280,56 +277,44 @@
% Rename
proc_info_vartypes(ProcInfo, AllTypes),
list.map(map.lookup(AllTypes), CalleeArgs, ActualTypes),
-
pred_info_typevarset(PredInfo, ActualTVarset),
-
- rename_using_module_info(ModuleInfo, CalleePPId, CalleeArgs,
+ sharing_as_rename_using_module_info(ModuleInfo, CalleePPId, CalleeArgs,
ActualTypes, ActualTVarset, CalleeSharing, RenamedSharing),
% Combine
- !:SharingAs = comb(ModuleInfo, ProcInfo, RenamedSharing, !.SharingAs)
+ !:SharingAs = sharing_as_comb(ModuleInfo, ProcInfo,
+ RenamedSharing, !.SharingAs)
;
GoalExpr = generic_call(_GenDetails, _, _, _),
goal_info_get_context(GoalInfo, Context),
context_to_string(Context, ContextString),
- !:SharingAs = top_sharing("generic call (" ++
- ContextString ++ ")", !.SharingAs)
- ;
- GoalExpr = switch(_, _, Cases),
- list.foldl3(analyse_case(ModuleInfo, PredInfo, ProcInfo,
- SharingTable, !.SharingAs),
- Cases, !FixpointTable,
- structure_sharing.domain.init, !:SharingAs,
- !IO)
+ !:SharingAs = sharing_as_top_sharing_accumulate(
+ "generic call (" ++ ContextString ++ ")", !.SharingAs)
;
GoalExpr = unify(_, _, _, Unification, _),
- !:SharingAs = add(ModuleInfo, ProcInfo, Unification, GoalInfo,
- !.SharingAs)
+ !:SharingAs = add_unify_sharing(ModuleInfo, ProcInfo, Unification,
+ GoalInfo, !.SharingAs)
;
GoalExpr = disj(Goals),
- SharingBase = !.SharingAs,
- AnalyseGoal = ( pred(G::in,
- FP0::in, FP::out, Sh0::in, Sh::out,
- IO0::di, IO1::uo) is det :-
- (
- analyse_goal(ModuleInfo, PredInfo, ProcInfo,
- SharingTable, G, FP0, FP,
- SharingBase, Sh1, IO0, IO1),
- Sh = least_upper_bound(ModuleInfo, ProcInfo, Sh0, Sh1)
- )),
- list.foldl3(AnalyseGoal, Goals, !FixpointTable,
- structure_sharing.domain.init, !:SharingAs, !IO)
+ list.foldl3(
+ analyse_disj(ModuleInfo, PredInfo, ProcInfo,
+ SharingTable, !.SharingAs),
+ Goals, !FixpointTable, sharing_as_init, !:SharingAs, !IO)
+ ;
+ GoalExpr = switch(_, _, Cases),
+ list.foldl3(
+ analyse_case(ModuleInfo, PredInfo, ProcInfo,
+ SharingTable, !.SharingAs),
+ Cases, !FixpointTable, sharing_as_init, !:SharingAs, !IO)
;
GoalExpr = not(_Goal)
% XXX Check theory, but a negated goal can not create bindings,
% hence it also can not create additional sharing.
;
- GoalExpr = scope(_, _),
- % XXX Check theory, check meaing of "scope/2" goal.
- goal_info_get_context(GoalInfo, Context),
- context_to_string(Context, ContextString),
- !:SharingAs = top_sharing("scope (" ++ ContextString ++ ")",
- !.SharingAs)
+ GoalExpr = scope(_, SubGoal),
+ % XXX Check theory.
+ analyse_goal(ModuleInfo, PredInfo, ProcInfo, SharingTable, SubGoal,
+ !FixpointTable, !SharingAs, !IO)
;
GoalExpr = if_then_else(_, IfGoal, ThenGoal, ElseGoal),
analyse_goal(ModuleInfo, PredInfo, ProcInfo, SharingTable,
@@ -338,7 +323,7 @@
ThenGoal, !FixpointTable, IfSharingAs, ThenSharingAs, !IO),
analyse_goal(ModuleInfo, PredInfo, ProcInfo, SharingTable,
ElseGoal, !FixpointTable, !.SharingAs, ElseSharingAs, !IO),
- !:SharingAs = least_upper_bound(ModuleInfo, ProcInfo,
+ !:SharingAs = sharing_as_least_upper_bound(ModuleInfo, ProcInfo,
ThenSharingAs, ElseSharingAs)
;
GoalExpr = foreign_proc(_Attrs, _ForeignPredId, _ForeignProcId,
@@ -347,13 +332,26 @@
% supported.
goal_info_get_context(GoalInfo, Context),
context_to_string(Context, ContextString),
- !:SharingAs = top_sharing("foreign_proc not handles yet ("
- ++ ContextString ++ ")", !.SharingAs)
+ !:SharingAs = sharing_as_top_sharing_accumulate(
+ "foreign_proc not handles yet (" ++ ContextString ++ ")",
+ !.SharingAs)
;
GoalExpr = shorthand(_),
unexpected(this_file, "analyse_goal: shorthand goal.")
).
+:- 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,
+ Goal, !FixpointTable, !Sharing, !IO) :-
+ analyse_goal(ModuleInfo, PredInfo, ProcInfo, SharingTable, Goal,
+ !FixpointTable, Sharing0, GoalSharing, !IO),
+ !:Sharing = sharing_as_least_upper_bound(ModuleInfo, ProcInfo, !.Sharing,
+ GoalSharing).
+
:- 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,
@@ -364,7 +362,7 @@
Case = case(_, Goal),
analyse_goal(ModuleInfo, PredInfo, ProcInfo, SharingTable, Goal,
!FixpointTable, Sharing0, CaseSharing, !IO),
- !:Sharing = least_upper_bound(ModuleInfo, ProcInfo, !.Sharing,
+ !:Sharing = sharing_as_least_upper_bound(ModuleInfo, ProcInfo, !.Sharing,
CaseSharing).
%-----------------------------------------------------------------------------%
@@ -404,7 +402,7 @@
% the sharing the called procedure creates is bottom.
predict_called_pred_is_bottom(ModuleInfo, PPId)
->
- SharingAs = structure_sharing.domain.init
+ SharingAs = sharing_as_init
;
% 4 -- use top-sharing with appropriate message.
SharingAs = top_sharing_not_found(ModuleInfo, PPId)
@@ -454,7 +452,7 @@
PPId = proc(PredId, ProcId),
PredModuleName = pred_info_module(PredInfo),
- TopSharing = top_sharing("Lookup sharing failed for " ++
+ TopSharing = sharing_as_top_sharing("Lookup sharing failed for " ++
sym_name_to_escaped_string(PredModuleName) ++ "." ++
pred_info_name(PredInfo) ++ "/" ++
int_to_string(pred_info_orig_arity(PredInfo)) ++ " (id = " ++
@@ -469,7 +467,7 @@
:- pred bottom_sharing_is_safe_approximation(module_info::in,
proc_info::in) is semidet.
-bottom_sharing_is_safe_approximation(ModuleInfo, ProcInfo):-
+bottom_sharing_is_safe_approximation(ModuleInfo, ProcInfo) :-
proc_info_headvars(ProcInfo, HeadVars),
proc_info_argmodes(ProcInfo, Modes),
proc_info_vartypes(ProcInfo, VarTypes),
@@ -492,14 +490,15 @@
% type is not primitive
\+ type_is_atomic(Type, ModuleInfo)
),
- list.filter(Test, ModeTypePairs, []).
+ 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.
-update_sharing_in_table(FixpointTable, PPId, !SharingTable):-
+update_sharing_in_table(FixpointTable, PPId, !SharingTable) :-
sharing_as_table_set(PPId,
ss_fixpoint_table_get_final_as(PPId, FixpointTable),
!SharingTable).
@@ -560,8 +559,8 @@
:- func ss_fixpoint_table_get_short_description(pred_proc_id,
ss_fixpoint_table) = string.
- % Retreive the structure sharing information without changing the
- % table. To be used after fixpoint has been reached.
+ % Retrieve the structure sharing information without changing the table.
+ % To be used after fixpoint has been reached.
% Software error if the procedure is not in the table.
%
:- func ss_fixpoint_table_get_final_as(pred_proc_id,
@@ -577,40 +576,39 @@
:- func wrapped_init(pred_proc_id) = sharing_as.
-wrapped_init(_Id) = structure_sharing.domain.init.
+wrapped_init(_Id) = sharing_as_init.
-ss_fixpoint_table_init(Keys) = fixpoint_table.init(wrapped_init, Keys).
+ss_fixpoint_table_init(Keys) = init_fixpoint_table(wrapped_init, Keys).
ss_fixpoint_table_new_run(!Table) :-
fixpoint_table.new_run(!Table).
ss_fixpoint_table_which_run(Tin) = fixpoint_table.which_run(Tin).
-ss_fixpoint_table_stable(Table) :- fixpoint_table.fixpoint_reached(Table).
+ss_fixpoint_table_stable(Table) :-
+ fixpoint_table.fixpoint_reached(Table).
ss_fixpoint_table_description(Table) = fixpoint_table.description(Table).
-ss_fixpoint_table_new_as(ModuleInfo, ProcInfo, Id, SharingAs, !Table):-
- fixpoint_table.add(domain.is_subsumed_by(ModuleInfo, ProcInfo),
+ss_fixpoint_table_new_as(ModuleInfo, ProcInfo, Id, SharingAs, !Table) :-
+ add_to_fixpoint_table(sharing_as_is_subsumed_by(ModuleInfo, ProcInfo),
Id, SharingAs, !Table).
ss_fixpoint_table_get_as(PPId, SharingAs, !Table) :-
- fixpoint_table.get(PPId, SharingAs, !Table).
+ get_from_fixpoint_table(PPId, SharingAs, !Table).
ss_fixpoint_table_get_short_description(PPId, Table) = Descr :-
- (
- As = ss_fixpoint_table_get_final_as_semidet(PPId, Table)
- ->
+ ( As = ss_fixpoint_table_get_final_as_semidet(PPId, Table) ->
Descr = short_description(As)
;
Descr = "-"
).
ss_fixpoint_table_get_final_as(PPId, T) =
- fixpoint_table.get_final(PPId, T).
+ get_from_fixpoint_table_final(PPId, T).
ss_fixpoint_table_get_final_as_semidet(PPId, T) =
- fixpoint_table.get_final_semidet(PPId, T).
+ get_from_fixpoint_table_final_semidet(PPId, T).
%-----------------------------------------------------------------------------%
Index: structure_sharing.domain.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_sharing.domain.m,v
retrieving revision 1.2
diff -u -b -r1.2 structure_sharing.domain.m
--- structure_sharing.domain.m 27 Feb 2006 08:05:21 -0000 1.2
+++ structure_sharing.domain.m 28 Feb 2006 05:55:01 -0000
@@ -70,20 +70,20 @@
% Operations w.r.t. the "bottom" element of the lattice.
%
-:- func init = sharing_as.
-:- pred is_bottom(sharing_as::in) is semidet.
+:- func sharing_as_init = sharing_as.
+:- pred sharing_as_is_bottom(sharing_as::in) is semidet.
% Operations w.r.t. the "top" element of the lattice. When sharing
% becomes top, it is useful to know why it has become top. This can
% be recorded and passed to the top-value as a string.
%
-:- func top_sharing(string) = sharing_as.
-:- func top_sharing(string, sharing_as) = sharing_as.
-:- pred is_top(sharing_as::in) is semidet.
+:- func sharing_as_top_sharing(string) = sharing_as.
+:- func sharing_as_top_sharing_accumulate(string, sharing_as) = sharing_as.
+:- pred sharing_as_is_top(sharing_as::in) is semidet.
% Return the size of the sharing set. Fail when sharing is top.
%
-:- func size(sharing_as) = int is semidet.
+:- func sharing_as_size(sharing_as) = int is semidet.
% Return a short description of the sharing information.
%
@@ -96,28 +96,31 @@
% * vars(SharingOut) is a subset of Vars.
% * 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 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.
% Renaming operation.
% This operation renames the variables and type variables occurring
% in the sharing information according to a variable and type variable
% mapping.
%
-:- pred rename(map(prog_var, prog_var)::in, tsubst::in, sharing_as::in,
- sharing_as::out) is det.
+:- pred sharing_as_rename(map(prog_var, prog_var)::in, tsubst::in,
+ sharing_as::in, sharing_as::out) is det.
+ % sharing_as_rename_using_module_info(ModuleInfo, PPId,
+ % ActualVars, ActualTypes, FormalSharing, ActualSharing):
+ %
% Renaming of the formal description of data structure sharing to the
% actual description of the sharing. The formal information is given
% 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, PPId, ActualVars, ActualTypes,
- % FormalSharing, ActualSharing).
%
-:- pred rename_using_module_info(module_info::in, pred_proc_id::in,
- prog_vars::in, list(mer_type)::in, tvarset::in, sharing_as::in,
- sharing_as::out) is det.
+:- pred sharing_as_rename_using_module_info(module_info::in,
+ pred_proc_id::in, prog_vars::in, list(mer_type)::in, tvarset::in,
+ sharing_as::in, sharing_as::out) is det.
% One of the cornerstone operations of using the program analysis system
% is to provide a "comb" (combination) operation that combines new
@@ -133,16 +136,17 @@
% The correct call is:
% Result = comb(ModuleInfo, ProcInfo, NewSharing, OldSharing).
%
-:- func comb(module_info, proc_info, sharing_as, sharing_as) = sharing_as.
+:- func sharing_as_comb(module_info, proc_info, sharing_as, sharing_as)
+ = sharing_as.
% Add the sharing created by a unification to the already existing sharing
% information.
%
-:- func add(module_info, proc_info, unification, hlds_goal_info,
+:- func add_unify_sharing(module_info, proc_info, unification, hlds_goal_info,
sharing_as) = sharing_as.
% XXX Not yet implemented.
-% :- func add_foreign_code(module_info, pred_proc_id, goal_info
+% :- func add_foreign_code_sharing(module_info, pred_proc_id, goal_info
% pragma_foreign_proc_attributes, list(foreign_arg),
% sharing_as) = sharing_as.
@@ -153,15 +157,15 @@
% in Set2, such that P1 is subsumed by P2 (i.e. P2 at least describes the
% same sharing as P1).
%
-:- pred is_subsumed_by(module_info::in, proc_info::in, sharing_as::in,
- sharing_as::in) is semidet.
+:- pred sharing_as_is_subsumed_by(module_info::in, proc_info::in,
+ sharing_as::in, sharing_as::in) is semidet.
% Compute the least upper bound.
%
-:- func least_upper_bound(module_info, proc_info, sharing_as,
- sharing_as) = sharing_as.
-:- func least_upper_bound(module_info, proc_info, list(sharing_as)) =
- sharing_as.
+:- func sharing_as_least_upper_bound(module_info, proc_info,
+ sharing_as, sharing_as) = sharing_as.
+:- func sharing_as_least_upper_bound_of_list(module_info, proc_info,
+ list(sharing_as)) = sharing_as.
% Compute the set of data structures whose memory representation coincide
% with the memory representation of the given datastructure.
@@ -169,11 +173,11 @@
% The operation produces a software error when called with a top alias
% description.
%
-:- func extend_datastruct(module_info, proc_info, datastruct,
- sharing_as) = list(datastruct).
+:- func extend_datastruct(module_info, proc_info, datastruct, sharing_as)
+ = list(datastruct).
% apply_widening(ModuleInfo, ProcInfo, WideningLimit, WideningDone,
- % SharingIn, SharingOut).
+ % SharingIn, SharingOut):
%
% Perform type widening on the structure sharing information if the
% size of the set is larger than the indicated widening limit (unless the
@@ -185,6 +189,7 @@
% type of the node that is selected by that selector, which widens the
% information that is represented by the initial structure sharing
% description.
+ %
:- pred apply_widening(module_info::in, proc_info::in, int::in, bool::out,
sharing_as::in, sharing_as::out) is det.
@@ -250,10 +255,10 @@
; bottom
; top(list(string)).
-init = bottom.
-is_bottom(bottom).
-top_sharing(Msg) = top([Msg]).
-top_sharing(Msg, SharingAs) = TopSharing :-
+sharing_as_init = bottom.
+sharing_as_is_bottom(bottom).
+sharing_as_top_sharing(Msg) = top([Msg]).
+sharing_as_top_sharing_accumulate(Msg, SharingAs) = TopSharing :-
(
SharingAs = real_as(_),
Msgs = [Msg]
@@ -266,10 +271,10 @@
),
TopSharing = top(Msgs).
-is_top(top(_)).
+sharing_as_is_top(top(_)).
-size(bottom) = 0.
-size(real_as(SharingSet)) = sharing_set_size(SharingSet).
+sharing_as_size(bottom) = 0.
+sharing_as_size(real_as(SharingSet)) = sharing_set_size(SharingSet).
short_description(bottom) = "b".
short_description(top(_)) = "t".
@@ -286,13 +291,13 @@
---> inproject
; outproject.
-project(ListVars, !SharingAs) :-
- project(inproject, ListVars, !SharingAs).
+sharing_as_project(ListVars, !SharingAs) :-
+ sharing_as_project_with_type(inproject, ListVars, !SharingAs).
-:- pred project(projection_type::in, prog_vars::in, sharing_as::in,
- sharing_as::out) is det.
+:- pred sharing_as_project_with_type(projection_type::in, prog_vars::in,
+ sharing_as::in, sharing_as::out) is det.
-project(ProjectionType, ListVars, !SharingAs) :-
+sharing_as_project_with_type(ProjectionType, ListVars, !SharingAs) :-
(
!.SharingAs = bottom
;
@@ -303,10 +308,10 @@
!.SharingAs = top(_)
).
-project_set(SetVars, !SharingAs) :-
- project(set.to_sorted_list(SetVars), !SharingAs).
+sharing_as_project_set(SetVars, !SharingAs) :-
+ sharing_as_project(set.to_sorted_list(SetVars), !SharingAs).
-rename(MapVar, TypeSubst, !SharingAs) :-
+sharing_as_rename(MapVar, TypeSubst, !SharingAs) :-
(
!.SharingAs = real_as(SharingSet0),
sharing_set_rename(MapVar, TypeSubst, SharingSet0, SharingSet),
@@ -317,7 +322,7 @@
!.SharingAs = top(_)
).
-rename_using_module_info(ModuleInfo, PPId, ActualVars, ActualTypes,
+sharing_as_rename_using_module_info(ModuleInfo, PPId, ActualVars, ActualTypes,
ActualTVarset, FormalSharing, ActualSharing):-
module_info_pred_proc_info(ModuleInfo, PPId, PredInfo, ProcInfo),
@@ -334,15 +339,13 @@
apply_variable_renaming_to_type_list(Renaming, FormalTypes,
RenFormalTypes),
- (
- type_list_subsumes(RenFormalTypes, ActualTypes, TypeSubstitution)
- ->
- rename(Dict, TypeSubstitution, FormalSharing, ActualSharing)
+ ( type_list_subsumes(RenFormalTypes, ActualTypes, TypeSubstitution) ->
+ sharing_as_rename(Dict, TypeSubstitution, FormalSharing, ActualSharing)
;
unexpected(this_file, "Types are supposed to be unifiable.")
).
-comb(ModuleInfo, ProcInfo, NewSharing, OldSharing) = ResultSharing :-
+sharing_as_comb(ModuleInfo, ProcInfo, NewSharing, OldSharing) = ResultSharing :-
(
NewSharing = real_as(NewSharingSet),
(
@@ -361,19 +364,19 @@
ResultSharing = OldSharing
;
NewSharing = top(MsgNew),
- (
- OldSharing = top(MsgOld)
- ->
+ ( OldSharing = top(MsgOld) ->
ResultSharing = top(list.append(MsgNew, MsgOld))
;
ResultSharing = NewSharing
)
).
-add(ModuleInfo, ProcInfo, Unification, GoalInfo, OldSharing) = NewSharing :-
+add_unify_sharing(ModuleInfo, ProcInfo, Unification, GoalInfo, OldSharing)
+ = NewSharing :-
UnifSharing = sharing_from_unification(ModuleInfo, ProcInfo, Unification,
GoalInfo),
- ResultSharing = comb(ModuleInfo, ProcInfo, UnifSharing, OldSharing),
+ ResultSharing = sharing_as_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
@@ -382,9 +385,7 @@
% NOTE: this "useless" sharing information can not be removed earlier as
% it can contribute to new sharing with the comb operation.
%
- (
- Unification = construct(_, _, _, _, _, _, _)
- ->
+ ( Unification = construct(_, _, _, _, _, _, _) ->
NewSharing = optimization_remove_deaths(ProcInfo,
GoalInfo, ResultSharing)
;
@@ -397,8 +398,8 @@
:- func sharing_from_unification(module_info, proc_info, unification,
hlds_goal_info) = sharing_as.
-sharing_from_unification(ModuleInfo, ProcInfo, Unification,
- GoalInfo) = Sharing :-
+sharing_from_unification(ModuleInfo, ProcInfo, Unification, GoalInfo)
+ = Sharing :-
(
Unification = construct(Var, ConsId, Args0, _, _, _, _),
list.takewhile(is_introduced_typeinfo_arg(ProcInfo), Args0,
@@ -426,19 +427,17 @@
)
;
Unification = assign(X, Y),
- (
- arg_has_primitive_type(ModuleInfo, ProcInfo, X)
- ->
- Sharing = init
+ ( arg_has_primitive_type(ModuleInfo, ProcInfo, X) ->
+ Sharing = sharing_as_init
;
new_entry(ModuleInfo, ProcInfo,
- datastruct.init(X) - datastruct.init(Y),
+ datastruct_init(X) - datastruct_init(Y),
sharing_set_init, SharingSet),
Sharing = wrap(SharingSet)
)
;
Unification = simple_test(_, _),
- Sharing = init
+ Sharing = sharing_as_init
;
Unification = complicated_unify(_, _, _),
unexpected(this_file, "complicated_unify during sharing analysis.")
@@ -469,13 +468,11 @@
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)
- ->
+ ( arg_has_primitive_type(ModuleInfo, ProcInfo, Arg) ->
true
;
- Data1 = datastruct.init(Var, ConsId, N),
- Data2 = datastruct.init(Arg),
+ Data1 = datastruct_init_with_pos(Var, ConsId, N),
+ Data2 = datastruct_init(Arg),
new_entry(ModuleInfo, ProcInfo, Data1 - Data2, !Sharing)
).
@@ -505,20 +502,17 @@
First = Pos1 - Var1,
list.foldl(
pred(OtherNumberedArg::in, S0::in, S::out) is det :-
- (
- OtherNumberedArg = Pos2 - Var1
- ->
+ ( OtherNumberedArg = Pos2 - Var1 ->
% Create sharing between Pos1 and Pos2
- Data1 = datastruct.init(Var, ConsId, Pos1),
- Data2 = datastruct.init(Var, ConsId, 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)
-
;
S = S0
),
Remainder, !Sharing),
- create_internal_sharing(ModuleInfo, ProcInfo,
- Var, ConsId, Remainder, !Sharing)
+ create_internal_sharing(ModuleInfo, ProcInfo, Var, ConsId, Remainder,
+ !Sharing)
;
NumberedArgs = []
).
@@ -553,9 +547,9 @@
%
set.difference(Deaths0, HeadVarsSet, Deaths),
set.to_sorted_list(Deaths, DeathsList),
- project(outproject, DeathsList, Sharing0, Sharing).
+ sharing_as_project_with_type(outproject, DeathsList, Sharing0, Sharing).
-is_subsumed_by(ModuleInfo, ProcInfo, Sharing1, Sharing2):-
+sharing_as_is_subsumed_by(ModuleInfo, ProcInfo, Sharing1, Sharing2):-
(
Sharing2 = top(_)
;
@@ -567,15 +561,14 @@
SharingSet2)
).
-least_upper_bound(ModuleInfo, ProcInfo, Sharing1, Sharing2) = Sharing :-
+sharing_as_least_upper_bound(ModuleInfo, ProcInfo, Sharing1, Sharing2)
+ = Sharing :-
(
Sharing1 = bottom,
Sharing = Sharing2
;
Sharing1 = top(Msg1),
- (
- Sharing2 = top(Msg2)
- ->
+ ( Sharing2 = top(Msg2) ->
Sharing = top(list.append(Msg1, Msg2))
;
Sharing = Sharing1
@@ -592,16 +585,15 @@
Sharing2 = real_as(SharingSet2),
Sharing = real_as(sharing_set_least_upper_bound(ModuleInfo,
ProcInfo, SharingSet1, SharingSet2))
-
)
).
-least_upper_bound(ModuleInfo, ProcInfo, SharingList) =
- list.foldl(least_upper_bound(ModuleInfo, ProcInfo), SharingList,
- init).
+sharing_as_least_upper_bound_of_list(ModuleInfo, ProcInfo, SharingList) =
+ list.foldl(sharing_as_least_upper_bound(ModuleInfo, ProcInfo), SharingList,
+ sharing_as_init).
-extend_datastruct(ModuleInfo, ProcInfo, Datastruct, SharingAs) =
- Datastructures :-
+extend_datastruct(ModuleInfo, ProcInfo, Datastruct, SharingAs)
+ = Datastructures :-
(
SharingAs = bottom,
Datastructures = []
@@ -623,13 +615,9 @@
WideningDone = no
;
!.Sharing = real_as(SharingSet0),
- (
- WideningLimit = 0
- ->
+ ( WideningLimit = 0 ->
WideningDone = no
- ;
- WideningLimit > sharing_set_size(SharingSet0)
- ->
+ ; WideningLimit > sharing_set_size(SharingSet0) ->
WideningDone = no
;
sharing_set_apply_widening(ModuleInfo, ProcInfo,
@@ -692,7 +680,7 @@
% structure sharing pairs it is involved in. These structure sharing pairs
% are represented as a map mapping selectors on data structure sets.
% Suppose (Sel-Data) is in the map to which prog_var V relates to, then this
-% means that the memory space for V^Sel might share with the memory spaces
+% means that the memory space for V ^ Sel might share with the memory spaces
% used for each of the data structures in Data.
% Note that in the sharing_set type we explicitly keep track of the number of
% structure sharing pairs at each level of the map.
@@ -758,8 +746,8 @@
:- 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.
+:- pred sharing_set_rename(map(prog_var, prog_var)::in, tsubst::in,
+ sharing_set::in, sharing_set::out) is det.
:- func sharing_set_comb(module_info, proc_info, sharing_set, sharing_set) =
sharing_set.
@@ -767,8 +755,8 @@
:- pred sharing_set_is_subsumed_by(module_info::in, proc_info::in,
sharing_set::in, sharing_set::in) is semidet.
-:- func sharing_set_least_upper_bound(module_info, proc_info, sharing_set,
- sharing_set) = sharing_set.
+:- func sharing_set_least_upper_bound(module_info, proc_info,
+ sharing_set, sharing_set) = sharing_set.
:- func sharing_set_extend_datastruct(module_info, proc_info, datastruct,
sharing_set) = list(datastruct).
@@ -793,9 +781,7 @@
sharing_set_size(sharing_set(Size, _)) = Size.
wrap(SharingSet, SharingAs) :-
- (
- sharing_set_is_empty(SharingSet)
- ->
+ ( sharing_set_is_empty(SharingSet) ->
SharingAs = bottom
;
SharingAs = real_as(SharingSet)
@@ -807,58 +793,60 @@
SharingSet0 = sharing_set(_, Map0),
(
ProjectionType = inproject,
- map.select(Map0, set.list_to_set(Vars), Map1)
+ map.select(Map0, set.list_to_set(Vars), Map)
;
ProjectionType = outproject,
map.keys(Map0, AllVars),
- set.difference(set.list_to_set(AllVars),
- set.list_to_set(Vars), Remainder),
- map.select(Map0, Remainder, Map1)
+ set.difference(set.list_to_set(AllVars), set.list_to_set(Vars),
+ Remainder),
+ map.select(Map0, Remainder, Map)
),
- 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)
- ->
+ map.foldl(project_and_update_sharing_set(ProjectionType, Vars),
+ Map, sharing_set_init, SharingSet).
+
+:- pred project_and_update_sharing_set(projection_type::in, prog_vars::in,
+ prog_var::in, selector_sharing_set::in, sharing_set::in, sharing_set::out)
+ is det.
+
+project_and_update_sharing_set(ProjectionType, Vars, Var, SelSet0, !SS) :-
+ selector_sharing_set_project(ProjectionType, Vars, SelSet0, SelSet),
+ ( selector_sharing_set_is_empty(SelSet) ->
true
;
- !.S = sharing_set(Size0, M0),
+ !.SS = sharing_set(Size0, M0),
map.det_insert(M0, Var, SelSet, M),
Size = Size0 + selector_sharing_set_size(SelSet),
- !:S = sharing_set(Size, M)
- )
- ), Map1, sharing_set_init, SharingSet).
+ !:SS = sharing_set(Size, M)
+ ).
sharing_set_rename(Dict, TypeSubst, SharingSet0, SharingSet) :-
SharingSet0 = sharing_set(Size, Map0),
- map.foldl(
- pred(Var0::in, SelectorSet0::in, M0::in, M::out) is det:-
- (
- selector_sharing_set_rename(Dict, TypeSubst,
- SelectorSet0, SelectorSet),
- map.lookup(Dict, Var0, Var),
+ map.foldl(do_sharing_set_rename(Dict, TypeSubst), Map0, map.init, Map),
+ SharingSet = sharing_set(Size, Map).
+
+:- pred do_sharing_set_rename(map(prog_var, prog_var)::in, tsubst::in,
+ prog_var::in, selector_sharing_set::in,
+ map(prog_var, selector_sharing_set)::in,
+ map(prog_var, selector_sharing_set)::out) is det.
+do_sharing_set_rename(Dict, TypeSubst, Var0, SelectorSet0, !Map) :-
+ selector_sharing_set_rename(Dict, TypeSubst, SelectorSet0, SelectorSet),
+ map.lookup(Dict, Var0, Var),
% XXX old code pretends that 2 vars can be renamed to
% one and the same new variable. Is that so?
% To check.
% (
- % map.search(M0, Var, SelectorSet2)
- %->
+ % map.search(!.Map, Var, SelectorSet2)
+ % ->
% % can occur when 2 vars are renamed to
% % the same var (call: append(X,X,Y))
% selector_sharing_set_add(SelectorSet1,
% SelectorSet2, SelectorSet),
- % map.det_update(M0, Var, SelectorSet, M)
- %;
- % map.det_insert(M0, Var, SelectorSet1, M)
- %)
- map.det_insert(M0, Var, SelectorSet, M)
- ),
- Map0,
- map.init,
- Map),
- SharingSet = sharing_set(Size, Map).
+ % map.det_update(!.Map, Var, SelectorSet, !:Map)
+ % ;
+ % map.det_insert(!.Map, Var, SelectorSet1, !:Map)
+ % )
+ map.det_insert(!.Map, Var, SelectorSet, !:Map).
% The implementation for combining sharing sets is to compute the
% alternating closure of those sets.
@@ -895,11 +883,11 @@
NewSharingSet, OldSharingSet),
% combine it all:
- ResultSharingSet = sharing_set_least_upper_bound(ModuleInfo, ProcInfo,
+ ResultSharingSet = sharing_set_least_upper_bound_list(ModuleInfo, ProcInfo,
[NewSharingSet, OldSharingSet, OldNewSharingSet, NewOldNewSharingSet]).
-
-% XXX new implementation.
+ % XXX new implementation.
+ %
:- func sharing_set_altclos_2(module_info, proc_info, sharing_set,
sharing_set) = sharing_set.
@@ -928,7 +916,8 @@
% \exists X where var(X) = V, and X-A \in NewSharingSet, and X-B \in
% OldSharingSet.
%
- list.foldl((pred(Var::in, !.SS::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),
@@ -937,18 +926,18 @@
new_entries(ModuleInfo, ProcInfo, SharingPairs, !SS)
), CommonVars, sharing_set_init, ResultSharingSet).
+ % sharing_set_altclos_3_directed(ModuleInfo, ProcInfo, NewSharingSet,
+ % OldSharingSet) =
+ % Compute the sharing pairs A-B such that exists X-Y \in OldSharingSet and
+ % A - X \subsumed by NewSharingSet,
+ % Y - B \subsumed by NewSharingSet.
+ % XXX New implementation.
+ %
+:- func sharing_set_altclos_3_directed(module_info, proc_info,
+ sharing_set, sharing_set) = sharing_set.
-% sharing_set_altclos_3_directed(ModuleInfo, ProcInfo, NewSharingSet,
-% OldSharingSet) =
-% Compute the sharing pairs A-B such that exists X-Y \in OldSharingSet and
-% A - X \subsumed by NewSharingSet,
-% Y - B \subsumed by NewSharingSet.
-% XXX New implementation.
-:- func sharing_set_altclos_3_directed(module_info, proc_info, sharing_set,
- sharing_set) = sharing_set.
-
-sharing_set_altclos_3_directed(ModuleInfo, ProcInfo, NewSharingSet,
- OldSharingSet) = ResultSharingSet :-
+sharing_set_altclos_3_directed(ModuleInfo, ProcInfo,
+ NewSharingSet, OldSharingSet) = ResultSharingSet :-
NewSharingSet = sharing_set(_, NewMap),
OldSharingSet = sharing_set(_, OldMap),
@@ -1007,9 +996,7 @@
% set, and adding them to the other sharing set.
Set1 = sharing_set(Size1, _),
Set2 = sharing_set(Size2, _),
- (
- Size1 < Size2
- ->
+ ( Size1 < Size2 ->
Pairs = to_sharing_pair_list(Set1),
Set = Set2
;
@@ -1018,21 +1005,19 @@
),
new_entries(ModuleInfo, ProcInfo, Pairs, Set, Union).
-:- func sharing_set_least_upper_bound(module_info, proc_info,
+:- func sharing_set_least_upper_bound_list(module_info, proc_info,
list(sharing_set)) = sharing_set.
-sharing_set_least_upper_bound(ModuleInfo, ProcInfo, ListSharingSet) =
+sharing_set_least_upper_bound_list(ModuleInfo, ProcInfo, ListSharingSet) =
list.foldl(sharing_set_least_upper_bound(ModuleInfo, ProcInfo),
ListSharingSet, sharing_set_init).
sharing_set_extend_datastruct(ModuleInfo, ProcInfo, Datastruct, SharingSet)
= Datastructures :-
SharingSet = sharing_set(_, SharingMap),
- Var = Datastruct^sc_var,
- Selector = Datastruct^sc_selector,
- (
- map.search(SharingMap, Var, SelectorSet)
- ->
+ Var = Datastruct ^ sc_var,
+ Selector = Datastruct ^ sc_selector,
+ ( map.search(SharingMap, Var, SelectorSet) ->
% The type of the variable is needed to be able to compare
% datastructures.
%
@@ -1072,8 +1057,8 @@
new_entry(ModuleInfo, ProcInfo, SharingPair0, !SharingSet) :-
% Normalize the sharing pair before doing anything.
SharingPair0 = DataX0 - DataY0,
- SharingPair = normalize(ModuleInfo, ProcInfo, DataX0) -
- normalize(ModuleInfo, ProcInfo, DataY0),
+ SharingPair = normalize_datastruct(ModuleInfo, ProcInfo, DataX0) -
+ normalize_datastruct(ModuleInfo, ProcInfo, DataY0),
(
sharing_set_subsumes_sharing_pair(ModuleInfo, ProcInfo,
@@ -1093,16 +1078,14 @@
new_entry_no_controls(SharingPair, !SS) :-
SharingPair = Data1 - Data2,
new_directed_entry(Data1, Data2, !SS),
- (
- ctgc.datastruct.equal(Data1, Data2)
- ->
+ ( datastruct_equal(Data1, Data2) ->
true
;
new_directed_entry(Data2, Data1, !SS)
).
-:- pred remove_entries(structure_sharing::in, sharing_set::in,
- sharing_set::out) is det.
+:- pred remove_entries(structure_sharing::in,
+ sharing_set::in, sharing_set::out) is det.
remove_entries(SharingPairs, !SS):-
list.foldl(remove_entry, SharingPairs, !SS).
@@ -1117,9 +1100,7 @@
remove_entry(SharingPair, !SharingSet) :-
SharingPair = Data1 - Data2,
remove_directed_entry(Data1, Data2, !SharingSet),
- (
- ctgc.datastruct.equal(Data1, Data2)
- ->
+ ( datastruct_equal(Data1, Data2) ->
true
;
remove_directed_entry(Data2, Data1, !SharingSet)
@@ -1137,25 +1118,17 @@
SelSharingSet0 = selector_sharing_set(SelSize0, SelSharingMap0),
map.lookup(SelSharingMap0, FromSel, DataSet0),
DataSet0 = datastructures(DataSize0, Data0),
- (
- set.remove(Data0, ToData, Data)
- ->
+ ( set.remove(Data0, ToData, Data) ->
DataSize = DataSize0 - 1,
SelSize = SelSize0 - 1,
Size = Size0 - 1,
- (
- Size = 0
- ->
+ ( Size = 0 ->
SharingSet = sharing_set(Size, map.init)
- ;
- SelSize = 0
- ->
+ ; SelSize = 0 ->
map.delete(SharingMap0, FromVar, SharingMap),
SharingSet = sharing_set(Size, SharingMap)
- ;
- DataSize = 0
- ->
+ ; DataSize = 0 ->
map.delete(SelSharingMap0, FromSel, SelSharingMap),
SelSharingSet = selector_sharing_set(SelSize, SelSharingMap),
map.det_update(SharingMap0, FromVar, SelSharingSet, SharingMap),
@@ -1204,15 +1177,15 @@
list.find_first_map(
pred(Sel::in, Data::out) is semidet :-
(
- selector.subsumed_by(ModuleInfo, Sel1, Sel, Type1, Extension),
+ subsumed_by(ModuleInfo, Sel1, Sel, Type1, Extension),
map.search(SelSharingMap, Sel, DataSet),
DataSet = datastructures(_, DatastructureSet),
MatchedDatastructs = list.filter(
pred(Datastructure::in) is semidet :-
(
- Var2 = Datastructure^sc_var,
- selector.subsumed_by(ModuleInfo, Sel2,
- Datastructure^sc_selector, Type2, Extension)
+ Var2 = Datastructure ^ sc_var,
+ ctgc.selector.subsumed_by(ModuleInfo, Sel2,
+ Datastructure ^ sc_selector, Type2, Extension)
),
to_sorted_list(DatastructureSet)),
% The list of matched datastructures contains at least one element.
@@ -1221,7 +1194,6 @@
SelectorList,
_).
-
% Return the list of sharing pairs included in the sharing set that are
% less or equal to the given sharing pair.
%
@@ -1243,9 +1215,7 @@
map.lookup(VarTypes, Var1, Type1),
map.lookup(VarTypes, Var2, Type2),
- (
- map.search(SharingMap, Var1, SelSharingSet)
- ->
+ ( map.search(SharingMap, Var1, SelSharingSet) ->
SelSharingSet = selector_sharing_set(_, SelSharingMap),
%
% Determine all Selector-Dataset pairs where
@@ -1257,21 +1227,22 @@
list.filter_map(
pred(Selector::in, SPairs::out) is semidet :-
(
- selector.subsumed_by(ModuleInfo, Selector, Sel1,
+ ctgc.selector.subsumed_by(ModuleInfo, Selector, Sel1,
Type1, Extension),
map.search(SelSharingMap, Selector, Dataset),
Dataset = datastructures(_, Datastructs),
list.filter_map(
pred(D::in, Pair::out) is semidet :-
(
- Var2 = D^sc_var,
- selector.subsumed_by(ModuleInfo, D^sc_selector, Sel2,
- Type2, Extension),
- Pair = datastruct.init(Var1, Selector) - D
+ Var2 = D ^ sc_var,
+ ctgc.selector.subsumed_by(ModuleInfo, D ^ sc_selector,
+ Sel2, Type2, Extension),
+ Pair = datastruct_init_with_selector(Var1, Selector)
+ - D
),
to_sorted_list(Datastructs),
SPairs),
- SPairs = [_|_]
+ SPairs = [_ | _]
),
SelectorList,
ListSubsumedPairs),
@@ -1293,10 +1264,9 @@
SharingSet0 = sharing_set(Size0, Map0),
Var = FromData ^ sc_var,
Selector = FromData ^ sc_selector,
+ ( map.search(Map0, Var, Selectors0) ->
(
- map.search(Map0, Var, Selectors0)
- ->
- ( selector_sharing_set_new_entry(Selector, ToData,
+ selector_sharing_set_new_entry(Selector, ToData,
Selectors0, Selectors)
->
map.det_update(Map0, Var, Selectors, Map),
@@ -1308,8 +1278,7 @@
;
(
selector_sharing_set_new_entry(Selector, ToData,
- selector_sharing_set_init,
- Selectors)
+ selector_sharing_set_init, Selectors)
->
map.det_insert(Map0, Var, Selectors, Map),
Size = Size0 + 1
@@ -1342,8 +1311,9 @@
structure_sharing::in, structure_sharing::out) is det.
to_sharing_pair_list_4(ProgVar, Selector, Datastruct, !Pairs) :-
- SharingPair = Datastruct - datastruct.init(ProgVar, Selector),
- !:Pairs = [ SharingPair | !.Pairs ].
+ SharingPair =
+ Datastruct - datastruct_init_with_selector(ProgVar, Selector),
+ !:Pairs = [SharingPair | !.Pairs].
:- func without_doubles(sharing_set) = sharing_set.
@@ -1370,13 +1340,14 @@
without_doubles_4(ProgVar, Selector, Datastruct, !SS) :-
(
- directed_entry_is_member(datastruct.init(ProgVar, Selector),
+ directed_entry_is_member(
+ datastruct_init_with_selector(ProgVar, Selector),
Datastruct, !.SS)
->
true
;
new_directed_entry(Datastruct,
- datastruct.init(ProgVar, Selector), !SS)
+ datastruct_init_with_selector(ProgVar, Selector), !SS)
).
:- pred directed_entry_is_member(datastruct::in, datastruct::in,
@@ -1384,8 +1355,8 @@
directed_entry_is_member(FromData, ToData, SharingSet) :-
SharingSet = sharing_set(_, Map),
- Var = FromData^sc_var,
- Selector = FromData^sc_selector,
+ Var = FromData ^ sc_var,
+ Selector = FromData ^ sc_selector,
map.search(Map, Var, SelSharingSet),
SelSharingSet = selector_sharing_set(_, SelectorMap),
map.search(SelectorMap, Selector, Dataset),
@@ -1430,8 +1401,8 @@
selector_sharing_set_is_empty(selector_sharing_set(0, _Map)).
selector_sharing_set_size(selector_sharing_set(Size,_)) = Size.
-selector_sharing_set_project(ProjectionType, Vars, SelSharingSet0,
- SelSharingSet):-
+selector_sharing_set_project(ProjectionType, Vars,
+ SelSharingSet0, SelSharingSet):-
SelSharingSet0 = selector_sharing_set(_, Map0),
map.foldl(selector_sharing_set_project_2(ProjectionType, Vars),
Map0, selector_sharing_set_init, SelSharingSet).
@@ -1442,9 +1413,7 @@
selector_sharing_set_project_2(ProjectionType, Vars, Selector, DataSet0, !SS):-
data_set_project(ProjectionType, Vars, DataSet0, DataSet),
- (
- data_set_is_empty(DataSet)
- ->
+ ( data_set_is_empty(DataSet) ->
true
;
!.SS = selector_sharing_set(Size0, Map0),
@@ -1455,8 +1424,7 @@
selector_sharing_set_rename(Dict, Subst, SelSharingSet0, SelSharingSet):-
SelSharingSet0 = selector_sharing_set(Size, Map0),
- map.foldl(selector_sharing_set_rename_2(Dict, Subst),
- Map0, map.init, Map),
+ map.foldl(selector_sharing_set_rename_2(Dict, Subst), Map0, map.init, Map),
SelSharingSet = selector_sharing_set(Size, Map).
:- pred selector_sharing_set_rename_2(map(prog_var, prog_var)::in,
@@ -1468,12 +1436,10 @@
data_set_rename(Dict, Subst, DataSet0, DataSet),
svmap.det_insert(Selector, DataSet, !Map).
-selector_sharing_set_new_entry(Selector, Datastruct, SelSharingSet0,
- SelSharingSet) :-
+selector_sharing_set_new_entry(Selector, Datastruct,
+ SelSharingSet0, SelSharingSet) :-
SelSharingSet0 = selector_sharing_set(Size0, Map0),
- (
- map.search(Map0, Selector, DataSet0)
- ->
+ ( map.search(Map0, Selector, DataSet0) ->
data_set_new_entry(Datastruct, DataSet0, DataSet),
Size = Size0 + 1,
map.det_update(Map0, Selector, DataSet, Map)
@@ -1484,8 +1450,8 @@
),
SelSharingSet = selector_sharing_set(Size, Map).
-selector_sharing_set_altclos(ModuleInfo, ProcInfo, Type, NewSelSet,
- OldSelSet) = NewSharingPairs :-
+selector_sharing_set_altclos(ModuleInfo, ProcInfo, Type, NewSelSet, OldSelSet)
+ = NewSharingPairs :-
NewSelSet = selector_sharing_set(_, NewMap),
OldSelSet = selector_sharing_set(_, OldMap),
@@ -1537,14 +1503,14 @@
(
% NewSel <= OldSel ie, \exists Extension: OldSel.Extension = NewSel.
- selector.subsumed_by(ModuleInfo, NewSel, OldSel, Type, Extension)
+ ctgc.selector.subsumed_by(ModuleInfo, NewSel, OldSel, Type, Extension)
->
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)
+ ctgc.selector.subsumed_by(ModuleInfo, OldSel, NewSel, Type, Extension)
->
data_set_termshift(NewDataSet, Extension, TermShiftedNewDataSet),
SharingPairs = data_set_directed_closure(TermShiftedNewDataSet,
@@ -1572,12 +1538,12 @@
selector_sharing_set_extend_datastruct_2(ModuleInfo, VarType, BaseSelector,
Selector, Dataset0) = Datastructures :-
- % if Sel is more general than Selector, i.e.
+ % If Sel is more general than Selector, i.e.
% Selector = Sel.Extension, apply this extension
% to all the datastructs associated with Sel, and add them
% to the set of datastructs collected.
(
- selector.subsumed_by(ModuleInfo, BaseSelector,
+ ctgc.selector.subsumed_by(ModuleInfo, BaseSelector,
Selector, VarType, Extension)
->
data_set_termshift(Dataset0, Extension, Dataset),
@@ -1590,12 +1556,9 @@
selector_sharing_set_apply_widening(ModuleInfo, ProcInfo, ProgVar,
!SelectorSharingSet, !SharingSetSize):-
!.SelectorSharingSet = selector_sharing_set(_, DataMap0),
-
map.foldl2(
- selector_sharing_set_apply_widening_2(ModuleInfo, ProcInfo,
- ProgVar),
+ selector_sharing_set_apply_widening_2(ModuleInfo, ProcInfo, ProgVar),
DataMap0, map.init, DataMap, 0, DataMapSize),
-
!:SharingSetSize = !.SharingSetSize + DataMapSize,
!:SelectorSharingSet = selector_sharing_set(DataMapSize, DataMap).
@@ -1609,22 +1572,19 @@
data_set_apply_widening(ModuleInfo, ProcInfo, DataSet, DataSet1),
% Widening of the ProgVar-Selector datastructure.
- ctgc.datastruct.apply_widening(ModuleInfo, ProcInfo,
- ctgc.datastruct.init(ProgVar, Selector), NewDataStruct),
+ datastruct_apply_widening(ModuleInfo, ProcInfo,
+ datastruct_init_with_selector(ProgVar, Selector), NewDataStruct),
NewSelector = NewDataStruct ^ sc_selector,
% Check if NewSelector is already in the resulting DataMap, if so,
% compute the least upper bound of the associated data_set's.
- (
- map.search(!.DataMap, NewSelector, ExistingDataSet)
- ->
+ ( map.search(!.DataMap, NewSelector, ExistingDataSet) ->
ExistingDataSetSize = data_set_size(ExistingDataSet),
DataSetFinal = data_set_least_upper_bound(ModuleInfo, ProcInfo,
DataSet1, ExistingDataSet),
DataSetFinalSize = data_set_size(DataSetFinal),
svmap.det_update(NewSelector, DataSetFinal, !DataMap),
- !:DataMapSize = !.DataMapSize - ExistingDataSetSize +
- DataSetFinalSize
+ !:DataMapSize = !.DataMapSize - ExistingDataSetSize + DataSetFinalSize
;
svmap.det_insert(NewSelector, DataSet1, !DataMap),
!:DataMapSize = !.DataMapSize + data_set_size(DataSet1)
@@ -1644,8 +1604,8 @@
:- 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_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.
@@ -1654,11 +1614,11 @@
:- func data_set_directed_closure(data_set, data_set) = structure_sharing.
-:- pred data_set_apply_widening(module_info::in, proc_info::in, data_set::in,
- data_set::out) is det.
+:- pred data_set_apply_widening(module_info::in, proc_info::in,
+ data_set::in, data_set::out) is det.
-:- func data_set_least_upper_bound(module_info, proc_info, data_set,
- data_set) = data_set.
+:- func data_set_least_upper_bound(module_info, proc_info,
+ data_set, data_set) = data_set.
data_set_init = datastructures(0, set.init).
@@ -1667,7 +1627,12 @@
data_set_size(datastructures(Size, _)) = Size.
data_set_project(ProjectionType, Vars, !DataSet) :-
- FilterData = (pred(Data::in) is semidet :-
+ data_set_filter(data_set_project_test(ProjectionType, Vars), !DataSet).
+
+:- pred data_set_project_test(projection_type::in, prog_vars::in,
+ datastruct::in) is semidet.
+
+data_set_project_test(ProjectionType, Vars, Data) :-
Var = Data ^ sc_var,
(
ProjectionType = inproject,
@@ -1675,9 +1640,7 @@
;
ProjectionType = outproject,
not list.member(Var, Vars)
- )
- ),
- data_set_filter(FilterData, !DataSet).
+ ).
data_set_rename(Dict, Subst, !DataSet) :-
!.DataSet = datastructures(_Size, Datastructs0),
@@ -1686,7 +1649,7 @@
data_set_termshift(DataSet0, Selector, DataSet) :-
DataSet0 = datastructures(Size, Set0),
- Set = set.map(datastruct.termshift(Selector), Set0),
+ Set = set.map(datastruct_termshift(Selector), Set0),
DataSet = datastructures(Size, Set).
data_set_new_entry(Datastruct, DataSet0, DataSet) :-
@@ -1705,12 +1668,15 @@
:- pred set_cross_product(set(T1)::in, set(T2)::in,
set(pair(T1, T2))::out) is det.
-set_cross_product(Set0, Set1, CrossProduct):-
- solutions_set((pred(Pair::out) is nondet :-
- set.member(Elem0, Set0),
- set.member(Elem1, Set1),
- Pair = Elem0 - Elem1
- ), CrossProduct).
+set_cross_product(SetA, SetB, CrossProduct):-
+ solutions_set(cross_product(SetA, SetB), CrossProduct).
+
+:- pred cross_product(set(T1)::in, set(T2)::in, pair(T1, T2)::out) is nondet.
+
+cross_product(SetA, SetB, Pair) :-
+ set.member(ElemA, SetA),
+ set.member(ElemB, SetB),
+ Pair = ElemA - ElemB.
:- pred data_set_filter(pred(datastruct)::in(pred(in) is semidet),
data_set::in, data_set::out) is det.
@@ -1720,8 +1686,8 @@
Datastructs = set.filter(Pred, Datastructs0),
!:DataSet = datastructures(set.count(Datastructs), Datastructs).
-data_set_least_upper_bound(ModuleInfo, ProcInfo, DataSet1,
- DataSet2) = DataSet :-
+data_set_least_upper_bound(ModuleInfo, ProcInfo, DataSet1, DataSet2)
+ = DataSet :-
DataSet1 = datastructures(_, Datastructs1),
DataSet2 = datastructures(_, Datastructs2),
set.fold(data_set_add_datastruct(ModuleInfo, ProcInfo),
@@ -1738,7 +1704,7 @@
->
true
;
- datastruct.subsumed_by_list(ModuleInfo, ProcInfo, Data,
+ datastruct_subsumed_by_list(ModuleInfo, ProcInfo, Data,
set.to_sorted_list(!.Datastructs))
->
true
@@ -1746,11 +1712,11 @@
svset.insert(Data, !Datastructs)
).
-% XXX ProcInfo could be replaced by a mercury type, as all the datastructures
-% within one single dataset have the same type (as they are sharing with one
-% and the same datastruct, hence, they must have the same type as that
-% datastruct).
data_set_apply_widening(ModuleInfo, ProcInfo, !DataSet):-
+ % XXX ProcInfo could be replaced by a mercury type, as all the
+ % datastructures within one single dataset have the same type
+ % (as they are sharing with one and the same datastruct, hence,
+ % they must have the same type as that datastruct).
!.DataSet = datastructures(_, Datastructs0),
set.fold(data_set_widen_and_add(ModuleInfo, ProcInfo),
Datastructs0, set.init, Datastructs),
@@ -1760,7 +1726,7 @@
set(datastruct)::in, set(datastruct)::out) is det.
data_set_widen_and_add(ModuleInfo, ProcInfo, Data0, !Datastructs):-
- datastruct.apply_widening(ModuleInfo, ProcInfo, Data0, Data),
+ datastruct_apply_widening(ModuleInfo, ProcInfo, Data0, Data),
data_set_add_datastruct(ModuleInfo, ProcInfo, Data, !Datastructs).
%-----------------------------------------------------------------------------%
Index: structure_sharing.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_sharing.m,v
retrieving revision 1.3
diff -u -b -r1.3 structure_sharing.m
cvs diff: Diffing notes
--------------------------------------------------------------------------
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