[m-rev.] for review: fix two aborts in structure sharing analysis
Peter Wang
novalazy at gmail.com
Tue Mar 4 13:31:57 AEDT 2008
For review by Nancy if possible.
Branches: main
Fix two compiler aborts in the structure sharing analysis.
compiler/ctgc.selector.m:
Fix a problem with widening structure sharing pairs in the presence of
existential types. We'd try to reduce a term selector to a type
selector of the type of the node selected by the term selector, but if
that node would be existentially typed then the compiler would abort.
To avoid that, we resort to reducing the selector to a type selector of
the parent node's type instead.
XXX not sure
Make `type_of_node' and `select_subtype' into semidet predicates which
fail if the selector would select an existentially typed node, rather
than aborting. Add det versions of the original functions.
Make `select_subtype' able to succeed on existentially typed functors
if the selector doesn't actually select an existentally typed
argument.
compiler/structure_sharing.domain.m:
Don't add a new sharing pair to a sharing set if the left and right
hand sides of the sharing pair are the same after normalisation. This
avoids a different abort if such a pair needs to be removed: it tries
to remove both (LHS - RHS) and (RHS - LHS) but since the two sides are
equal, only one copy of the pair would exist in the sharing set to be
removed.
tests/valid/Mercury.options:
tests/valid/Mmakefile:
tests/valid/sharing_exist.m:
Add test case.
Index: compiler/ctgc.selector.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ctgc.selector.m,v
retrieving revision 1.10
diff -u -r1.10 ctgc.selector.m
--- compiler/ctgc.selector.m 19 Feb 2008 00:55:04 -0000 1.10
+++ compiler/ctgc.selector.m 4 Mar 2008 02:29:34 -0000
@@ -54,11 +54,18 @@
:- 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).
+ % SubType = det_type_of_node(ModuleInfo, StartType, Selector).
% Determines the type SubType of the node obtained by traversing the type
- % tree of StartType using the path Selector.
+ % tree of StartType using the path Selector. Abort if SubType would be an
+ % existential type.
%
-:- func type_of_node(module_info, mer_type, selector) = mer_type.
+:- func det_type_of_node(module_info, mer_type, selector) = mer_type.
+
+ % As above but fail if the subtype would be an existential type instead of
+ % aborting.
+ %
+:- pred type_of_node(module_info::in, mer_type::in, selector::in,
+ mer_type::out) is semidet.
% Abbreviate a selector to the type of the node it selects.
%
@@ -135,7 +142,7 @@
% such that S2_part1.Rest = S1) lead through a node with type
% "SubType".
%
- S2_part1_type = type_of_node(ModuleInfo, MainType, S2_part1),
+ S2_part1_type = det_type_of_node(ModuleInfo, MainType, S2_part1),
type_on_path(ModuleInfo, S2_part1_type, SubType, Rest, Remainder),
% step 3:
@@ -154,40 +161,64 @@
selector_subsumed_by(S1, S2, Extension):-
list.append(S2, Extension, S1).
-type_of_node(ModuleInfo, StartType, Selector) = SubType :-
+det_type_of_node(ModuleInfo, StartType, Selector) = SubType :-
+ ( type_of_node(ModuleInfo, StartType, Selector, SubType0) ->
+ SubType = SubType0
+ ;
+ unexpected(this_file, "type_of_node: existential subtype")
+ ).
+
+type_of_node(ModuleInfo, StartType, Selector, SubType) :-
(
Selector = [UnitSelector | RestSelector],
(
UnitSelector = termsel(ConsId, Index),
- SubType0 = select_subtype(ModuleInfo, StartType, ConsId, Index)
+ select_subtype(ModuleInfo, StartType, ConsId, Index, SubType0)
;
UnitSelector = typesel(SubType0)
),
- SubType = type_of_node(ModuleInfo, SubType0, RestSelector)
+ type_of_node(ModuleInfo, SubType0, RestSelector, SubType)
;
Selector = [],
SubType = StartType
).
- % select_subtype(ModuleInfo, Type, ConsID, Position) = SubType.
+ % det_select_subtype(ModuleInfo, Type, ConsID, Position) = SubType.
% Determine the type of the type node selected from the type tree Type,
% selecting the specific constructor (ConsId), at position Position.
% Position counts starting from 1.
%
-:- func select_subtype(module_info, mer_type, cons_id, int) = mer_type.
+:- func det_select_subtype(module_info, mer_type, cons_id, int) = mer_type.
+
+det_select_subtype(ModuleInfo, Type, ConsID, Position) = SubType :-
+ ( select_subtype(ModuleInfo, Type, ConsID, Position, SubType0) ->
+ SubType = SubType0
+ ;
+ unexpected(this_file, "select_subtype: existential subtype")
+ ).
+
+:- pred select_subtype(module_info::in, mer_type::in, cons_id::in, int::in,
+ mer_type::out) is semidet.
-select_subtype(ModuleInfo, Type, ConsID, Position) = SubType :-
+select_subtype(ModuleInfo, Type, ConsID, Position, SubType) :-
(
get_cons_id_non_existential_arg_types(ModuleInfo, Type, ConsID,
ArgTypes)
->
- ( list.index1(ArgTypes, Position, SubType0) ->
- SubType = SubType0
- ;
- unexpected(this_file, "get_type_of_node: selection failed.")
+ SubType = list.det_index1(ArgTypes, Position)
+ ;
+ get_existq_cons_defn(ModuleInfo, Type, ConsID, CtorDefn)
+ ->
+ CtorDefn = ctor_defn(_TVarSet, ExistQVars, _KindMap, _Constraints,
+ ArgTypes, _RetType),
+ SubType = list.det_index1(ArgTypes, Position),
+ not (
+ SubType = type_variable(TVar, _),
+ list.member(TVar, ExistQVars)
)
;
- unexpected(this_file, "get_type_of_node: existential type.")
+ unexpected(this_file,
+ "select_subtype: type is both existential and non-existential")
).
% split_upto_type_selector(Sin, S1, TS, S2).
@@ -272,7 +303,7 @@
)
;
UnitSelector = termsel(ConsId, Index),
- SubType = select_subtype(ModuleInfo, FromType, ConsId, Index),
+ SubType = det_select_subtype(ModuleInfo, FromType, ConsId, Index),
( SubType = ToType ->
(
% Check if the same type occurs anywhere further on the
@@ -370,13 +401,21 @@
!:Selector = SelectorAcc0
).
-selector_apply_widening(ModuleInfo, MainType, !Selector) :-
+selector_apply_widening(ModuleInfo, MainType, Selector0, Selector) :-
(
- !.Selector = []
+ Selector0 = [],
+ Selector = []
;
- !.Selector = [_ | _],
- UnitSelector = typesel(type_of_node(ModuleInfo, MainType, !.Selector)),
- !:Selector = [UnitSelector]
+ Selector0 = [_ | _],
+ ( type_of_node(ModuleInfo, MainType, Selector0, SubType) ->
+ Selector = [typesel(SubType)]
+ ;
+ % The node is existentially typed. Try for the type of the node's
+ % parent instead.
+ list.det_split_last(Selector0, ParentSelector, _),
+ selector_apply_widening(ModuleInfo, MainType, ParentSelector,
+ Selector)
+ )
).
%-----------------------------------------------------------------------------%
Index: compiler/structure_sharing.domain.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_sharing.domain.m,v
retrieving revision 1.27
diff -u -r1.27 structure_sharing.domain.m
--- compiler/structure_sharing.domain.m 19 Feb 2008 00:55:04 -0000 1.27
+++ compiler/structure_sharing.domain.m 4 Mar 2008 02:19:25 -0000
@@ -1294,14 +1294,19 @@
sharing_set::in, sharing_set::out) is det.
new_entry(ModuleInfo, ProcInfo, SharingPair0, !SharingSet) :-
- % Normalize the sharing pair before doing anything.
SharingPair0 = DataX0 - DataY0,
- SharingPair = normalize_datastruct(ModuleInfo, ProcInfo, DataX0) -
- normalize_datastruct(ModuleInfo, ProcInfo, DataY0),
-
+ % Normalize the sharing pair before doing anything.
+ DataX = normalize_datastruct(ModuleInfo, ProcInfo, DataX0),
+ DataY = normalize_datastruct(ModuleInfo, ProcInfo, DataY0),
+ SharingPair = DataX - DataY,
(
- sharing_set_subsumes_sharing_pair(ModuleInfo, ProcInfo,
- !.SharingSet, SharingPair)
+ (
+ % Ignore sharing pairs which are exactly the same.
+ DataX = DataY
+ ;
+ sharing_set_subsumes_sharing_pair(ModuleInfo, ProcInfo,
+ !.SharingSet, SharingPair)
+ )
->
true
;
Index: tests/valid/Mercury.options
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/valid/Mercury.options,v
retrieving revision 1.46
diff -u -r1.46 Mercury.options
--- tests/valid/Mercury.options 4 Mar 2008 00:36:06 -0000 1.46
+++ tests/valid/Mercury.options 4 Mar 2008 02:08:18 -0000
@@ -100,6 +100,7 @@
MCFLAGS-pred_with_no_modes = --infer-all
MCFLAGS-quantifier_warning = --halt-at-warn
MCFLAGS-reuse_static = --ctgc --deforestation
+MCFLAGS-sharing_exist = --ctgc --structure-sharing-widening 1
MCFLAGS-simplify_bug2 = -O3
MCFLAGS-simplify_bug = -O-1
MCFLAGS-solver_type_bug = --halt-at-warn
Index: tests/valid/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/valid/Mmakefile,v
retrieving revision 1.208
diff -u -r1.208 Mmakefile
--- tests/valid/Mmakefile 4 Mar 2008 00:36:06 -0000 1.208
+++ tests/valid/Mmakefile 4 Mar 2008 02:10:24 -0000
@@ -195,6 +195,7 @@
same_length_2 \
semidet_disj \
shape_type \
+ sharing_exist \
simplify_bug \
simplify_bug2 \
size_prof_ho_bug \
Index: tests/valid/sharing_exist.m
===================================================================
RCS file: tests/valid/sharing_exist.m
diff -N tests/valid/sharing_exist.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/valid/sharing_exist.m 4 Mar 2008 02:09:49 -0000
@@ -0,0 +1,24 @@
+% Regression test. Structure sharing widening caused compiler aborts in the
+% presence of existential types.
+%
+% Uncaught Mercury exception:
+% Software Error: ctgc.selector.m: Unexpected: get_type_of_node: existential
+% type.
+
+:- module sharing_exist.
+:- interface.
+
+:- type quux
+ ---> some [T] quux(T, string).
+
+:- pred replace(quux::in, T::in, quux::out) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+replace(Q0, X, Q) :-
+ Q0 = quux(_, Y),
+ Q = 'new quux'(X, Y).
+
+% vi:ft=mercury:ts=8:sts=4:sw=4:et
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list