[m-rev.] diff: [CTGC] fix sharing analysis not reaching fixpoint
Peter Wang
novalazy at gmail.com
Thu Jul 24 16:02:06 AEST 2008
Branches: main
compiler/ctgc.selector.m:
Fix a bug in the implementation of ctgc.selector.subsumed_by which
caused structure sharing analysis to never reach a fixpoint for a
certain module, with sharing widening enabled.
tests/valid/Mercury.options:
tests/valid/Mmakefile:
tests/valid/sharing_loop2.m:
Add the test case.
tests/valid/sharing_loop3.m:
Another test case. The compiler didn't fail on this module before
or after the change, but it did fail on it when I made a different
"fix", so add it too.
diff --git a/compiler/ctgc.selector.m b/compiler/ctgc.selector.m
index 2be433c..74788af 100644
--- a/compiler/ctgc.selector.m
+++ b/compiler/ctgc.selector.m
@@ -217,6 +217,13 @@ subsumed_by_2(ModuleInfo, A, B, Type, Extension) :-
type_contains_subtype(ModuleInfo, SubTypeB, SubTypeA),
subsumed_by_2(ModuleInfo, A, BT, SubTypeB, Extension0)
->
+ % Don't succeed for something like:
+ % A = [typesel(foo)],
+ % B = [typesel(bar)],
+ % Ext = [typesel(foo)]
+ % i.e.
+ % [typesel(bar), typesel(foo)] = [typesel(bar)]
+ Extension0 \= A,
Extension = Extension0
;
% Assume we select node according to the A selector, then check
diff --git a/tests/valid/Mercury.options b/tests/valid/Mercury.options
index 65b42d4..2ad0d4d 100644
--- a/tests/valid/Mercury.options
+++ b/tests/valid/Mercury.options
@@ -104,6 +104,8 @@ MCFLAGS-quantifier_warning = --halt-at-warn
MCFLAGS-reuse_static = --ctgc --deforestation
MCFLAGS-sharing_exist = --ctgc --structure-sharing-widening 1
MCFLAGS-sharing_loop = --ctgc --structure-sharing-widening 8
+MCFLAGS-sharing_loop2 = --ctgc --structure-sharing-widening 10
+MCFLAGS-sharing_loop3 = --ctgc --structure-sharing-widening 10
MCFLAGS-simplify_bug2 = -O3
MCFLAGS-simplify_bug = -O-1
MCFLAGS-solver_type_bug = --halt-at-warn
diff --git a/tests/valid/Mmakefile b/tests/valid/Mmakefile
index 3e48ada..9b61c9c 100644
--- a/tests/valid/Mmakefile
+++ b/tests/valid/Mmakefile
@@ -273,7 +273,9 @@ PAR_CONJ_PROGS = \
CTGC_PROGS = \
reuse_static \
sharing_exist \
- sharing_loop
+ sharing_loop \
+ sharing_loop2 \
+ sharing_loop3
# The following programs require that num_tag_bits >= 1
RESERVE_TAG_PROGS = \
diff --git a/tests/valid/sharing_loop2.m b/tests/valid/sharing_loop2.m
new file mode 100644
index 0000000..14f1f88
--- /dev/null
+++ b/tests/valid/sharing_loop2.m
@@ -0,0 +1,108 @@
+% Regression test. The structure sharing analysis wasn't able to reach a
+% fixpoint analysing this module with --structure-sharing-widening set to
+% certain values.
+
+:- module sharing_loop2.
+:- interface.
+
+:- type lval
+ ---> field(rval)
+ ; mem_ref(rval).
+
+:- type rval
+ ---> lval(lval)
+ ; const(data_name)
+ ; binop(rval, rval)
+ ; mem_addr(mem_ref).
+
+:- type mem_ref
+ ---> heap_ref(rval, rval).
+
+:- type data_name
+ ---> scalar_common_ref(type_num)
+ ; vector_common_ref(type_num, int).
+
+:- type type_num ---> type_num(int).
+
+:- type static_cell_remap_info.
+
+:- func remap_lval(static_cell_remap_info, lval) = lval.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- type static_cell_remap_info
+ ---> static_cell_remap_info(
+ cell_type_num_remap,
+ data_name
+ ).
+
+:- type cell_type_num_remap
+ ---> cell_type_num_remap(type_num, type_num).
+
+%-----------------------------------------------------------------------------%
+
+remap_lval(Remap, Lval0) = Lval :-
+ (
+ Lval0 = field(Rval0),
+ Rval = remap_rval(Remap, Rval0),
+ Lval = field(Rval)
+ ;
+ Lval0 = mem_ref(Rval0),
+ Rval = remap_rval(Remap, Rval0),
+ Lval = mem_ref(Rval)
+ ).
+
+:- func remap_rval(static_cell_remap_info, rval) = rval.
+
+remap_rval(Remap, Rval0) = Rval :-
+ (
+ Rval0 = lval(Lval0),
+ Lval = remap_lval(Remap, Lval0),
+ Rval = lval(Lval)
+ ;
+ Rval0 = const(DataName0),
+ DataName = remap_data_name(Remap, DataName0),
+ Rval = const(DataName)
+ ;
+ Rval0 = binop(A0, B0),
+ A = remap_rval(Remap, A0),
+ B = remap_rval(Remap, B0),
+ Rval = binop(A, B)
+ ;
+ Rval0 = mem_addr(MemRef0),
+ MemRef = remap_mem_ref(Remap, MemRef0),
+ Rval = mem_addr(MemRef)
+ ).
+
+:- func remap_data_name(static_cell_remap_info, data_name) = data_name.
+
+remap_data_name(Remap, DataName0) = DataName :-
+ Remap = static_cell_remap_info(TypeNumRemap, ScalarCellGroupRemap),
+ (
+ DataName0 = scalar_common_ref(TypeNum0),
+ ( TypeNumRemap = cell_type_num_remap(TypeNum0, _) ->
+ ScalarCellGroupRemap = DataName
+ ;
+ DataName = DataName0
+ )
+ ;
+ DataName0 = vector_common_ref(TypeNum0, Offset),
+ ( TypeNumRemap = cell_type_num_remap(TypeNum0, TypeNum) ->
+ DataName = vector_common_ref(TypeNum, Offset)
+ ;
+ DataName = DataName0
+ )
+ ).
+
+:- func remap_mem_ref(static_cell_remap_info, mem_ref) = mem_ref.
+
+remap_mem_ref(Remap, MemRef0) = MemRef :-
+ MemRef0 = heap_ref(Ptr0, FieldNum),
+ Ptr = remap_rval(Remap, Ptr0),
+ MemRef = heap_ref(Ptr, FieldNum).
+
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=8 sts=4 sw=4 et
diff --git a/tests/valid/sharing_loop3.m b/tests/valid/sharing_loop3.m
new file mode 100644
index 0000000..1f7217c
--- /dev/null
+++ b/tests/valid/sharing_loop3.m
@@ -0,0 +1,181 @@
+% Regression test for structure sharing analysis with
+% --structure-sharing-widening set to certain values.
+
+:- module sharing_loop3.
+:- interface.
+
+:- type instrmap == mymap(label, instruction).
+:- type mymap(T, U).
+
+:- pred short_labels_rval(instrmap::in, rval::in, rval::out) is det.
+
+:- type instruction
+ ---> llds_instr(instr, string).
+
+:- type instr
+ ---> label(label)
+ ; goto.
+
+:- type label
+ ---> internal_label(string).
+
+:- type code_addr
+ ---> code_label(label).
+
+:- type lval
+ ---> succip_slot(rval)
+ ; mem_ref(rval).
+
+:- type rval
+ ---> lval(lval)
+ ; const(rval_const)
+ ; binop(rval, rval)
+ ; mem_addr(int).
+
+:- type rval_const
+ ---> llconst_code_addr(code_addr).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- pred short_label(instrmap::in, label::in, label::out) is det.
+
+short_label(Instrmap, Label0, Label) :-
+ ( search(Instrmap, Label0, Instr0) ->
+ final_dest(Instrmap, Label0, Label, Instr0, _Instr)
+ ;
+ Label = Label0
+ ).
+
+:- pred final_dest(instrmap::in, label::in, label::out, instruction::in,
+ instruction::out) is det.
+
+final_dest(Instrmap, SrcLabel, DestLabel, SrcInstr, DestInstr) :-
+ (
+ SrcInstr = llds_instr(SrcUinstr, _Comment),
+ SrcUinstr = label(TargetLabel),
+ search(Instrmap, TargetLabel, TargetInstr)
+ ->
+ final_dest(Instrmap,
+ TargetLabel, DestLabel, TargetInstr, DestInstr)
+ ;
+ DestLabel = SrcLabel,
+ DestInstr = SrcInstr
+ ).
+
+short_labels_rval(Instrmap, lval(Lval0), lval(Lval)) :-
+ short_labels_lval(Instrmap, Lval0, Lval).
+short_labels_rval(Instrmap, const(Const0), const(Const)) :-
+ short_labels_const(Instrmap, Const0, Const).
+short_labels_rval(Instrmap, binop(LRval0, RRval0),
+ binop(LRval, RRval)) :-
+ short_labels_rval(Instrmap, LRval0, LRval),
+ short_labels_rval(Instrmap, RRval0, RRval).
+short_labels_rval(_, mem_addr(MemRef), mem_addr(MemRef)).
+
+:- pred short_labels_const(instrmap::in,
+ rval_const::in, rval_const::out) is det.
+
+short_labels_const(Instrmap, llconst_code_addr(CodeAddr0),
+ llconst_code_addr(CodeAddr)) :-
+ CodeAddr0 = code_label(Label0),
+ short_label(Instrmap, Label0, Label),
+ CodeAddr = code_label(Label).
+
+:- pred short_labels_lval(instrmap::in, lval::in, lval::out) is det.
+
+short_labels_lval(Instrmap, succip_slot(Rval0), succip_slot(Rval)) :-
+ short_labels_rval(Instrmap, Rval0, Rval).
+short_labels_lval(Instrmap, mem_ref(Rval0), mem_ref(Rval)) :-
+ short_labels_rval(Instrmap, Rval0, Rval).
+
+%-----------------------------------------------------------------------------%
+
+:- type mymap(K, V)
+ ---> empty
+ ; two(K, V, mymap(K, V), mymap(K, V))
+ ; three(K, V, K, V, mymap(K, V), mymap(K, V), mymap(K, V))
+ ; four(K, V, K, V, K, V, mymap(K, V), mymap(K, V),
+ mymap(K, V), mymap(K, V)).
+
+:- pred search(mymap(K, V)::in, K::in, V::out) is semidet.
+
+search(T, K, V) :-
+ (
+ T = empty,
+ fail
+ ;
+ T = two(K0, V0, T0, T1),
+ compare(Result, K, K0),
+ (
+ Result = (<),
+ search(T0, K, V)
+ ;
+ Result = (=),
+ V = V0
+ ;
+ Result = (>),
+ search(T1, K, V)
+ )
+ ;
+ T = three(K0, V0, K1, V1, T0, T1, T2),
+ compare(Result0, K, K0),
+ (
+ Result0 = (<),
+ search(T0, K, V)
+ ;
+ Result0 = (=),
+ V = V0
+ ;
+ Result0 = (>),
+ compare(Result1, K, K1),
+ (
+ Result1 = (<),
+ search(T1, K, V)
+ ;
+ Result1 = (=),
+ V = V1
+ ;
+ Result1 = (>),
+ search(T2, K, V)
+ )
+ )
+ ;
+ T = four(K0, V0, K1, V1, K2, V2, T0, T1, T2, T3),
+ compare(Result1, K, K1),
+ (
+ Result1 = (<),
+ compare(Result0, K, K0),
+ (
+ Result0 = (<),
+ search(T0, K, V)
+ ;
+ Result0 = (=),
+ V = V0
+ ;
+ Result0 = (>),
+ search(T1, K, V)
+ )
+ ;
+ Result1 = (=),
+ V = V1
+ ;
+ Result1 = (>),
+ compare(Result2, K, K2),
+ (
+ Result2 = (<),
+ search(T2, K, V)
+ ;
+ Result2 = (=),
+ V = V2
+ ;
+ Result2 = (>),
+ search(T3, K, V)
+ )
+ )
+ ).
+
+%-----------------------------------------------------------------------------%
+% vim: 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