for review: bug fix for deforestation
Simon Taylor
stayl at cs.mu.OZ.AU
Tue Nov 3 16:12:29 AEDT 1998
Estimated hours taken: 2
compiler/pd_util.m:
Fix a bug in inst_MSG caused by not keeping track
of the set of already expanded insts.
tests/valid/deforest_loop.m:
Regression test.
Index: pd_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/pd_util.m,v
retrieving revision 1.2
diff -u -t -u -r1.2 pd_util.m
--- pd_util.m 1998/07/08 20:07:06 1.2
+++ pd_util.m 1998/10/29 07:49:23
@@ -680,44 +680,62 @@
% optimization, not loss of correctness.
inst_MSG(InstA, InstB, ModuleInfo, Inst) :-
+ set__init(Expansions),
+ inst_MSG_1(InstA, InstB, Expansions, ModuleInfo, Inst).
+
+:- type expansions == set(pair(inst)).
+
+:- pred inst_MSG_1(inst, inst, expansions, module_info, inst).
+:- mode inst_MSG_1(in, in, in, in, out) is semidet.
+
+inst_MSG_1(InstA, InstB, Expansions, ModuleInfo, Inst) :-
( InstA = InstB ->
Inst = InstA
;
+ % We don't do recursive MSGs (we could,
+ % but it's probably not worth it).
+ \+ set__member(InstA - InstB, Expansions),
inst_expand(ModuleInfo, InstA, InstA2),
inst_expand(ModuleInfo, InstB, InstB2),
+ set__insert(Expansions, InstA - InstB, Expansions1),
( InstB2 = not_reached ->
Inst = InstA2
;
- inst_MSG_2(InstA2, InstB2, ModuleInfo, Inst)
+ inst_MSG_2(InstA2, InstB2, Expansions1,
+ ModuleInfo, Inst)
)
).
-:- pred inst_MSG_2(inst, inst, module_info, inst).
-:- mode inst_MSG_2(in, in, in, out) is semidet.
+:- pred inst_MSG_2(inst, inst, expansions, module_info, inst).
+:- mode inst_MSG_2(in, in, in, in, out) is semidet.
-inst_MSG_2(any(_), any(Uniq), _, any(Uniq)).
-inst_MSG_2(free, free, _M, free).
+inst_MSG_2(any(_), any(Uniq), _, _, any(Uniq)).
+inst_MSG_2(free, free, _M, _, free).
-inst_MSG_2(bound(_, ListA), bound(UniqB, ListB), ModuleInfo, Inst) :-
- bound_inst_list_MSG(ListA, ListB, ModuleInfo, UniqB, ListB, Inst).
-inst_MSG_2(bound(_, _), ground(UniqB, InfoB), _, ground(UniqB, InfoB)).
+inst_MSG_2(bound(_, ListA), bound(UniqB, ListB), Expansions,
+ ModuleInfo, Inst) :-
+ bound_inst_list_MSG(ListA, ListB, Expansions,
+ ModuleInfo, UniqB, ListB, Inst).
+inst_MSG_2(bound(_, _), ground(UniqB, InfoB), _, _, ground(UniqB, InfoB)).
% fail here, since the increasing inst size could
% cause termination problems for deforestation.
-inst_MSG_2(ground(_, _), bound(_UniqB, _ListB), _, _) :- fail.
-inst_MSG_2(ground(_, _), ground(UniqB, InfoB), _, ground(UniqB, InfoB)).
+inst_MSG_2(ground(_, _), bound(_UniqB, _ListB), _, _, _) :- fail.
+inst_MSG_2(ground(_, _), ground(UniqB, InfoB), _, _, ground(UniqB, InfoB)).
inst_MSG_2(abstract_inst(Name, ArgsA), abstract_inst(Name, ArgsB),
- ModuleInfo, abstract_inst(Name, Args)) :-
- inst_list_MSG(ArgsA, ArgsB, ModuleInfo, Args).
-inst_MSG_2(not_reached, Inst, _, Inst).
-
-:- pred inst_list_MSG(list(inst), list(inst), module_info, list(inst)).
-:- mode inst_list_MSG(in, in, in, out) is semidet.
-
-inst_list_MSG([], [], _ModuleInfo, []).
-inst_list_MSG([ArgA | ArgsA], [ArgB | ArgsB], ModuleInfo, [Arg | Args]) :-
- inst_MSG(ArgA, ArgB, ModuleInfo, Arg),
- inst_list_MSG(ArgsA, ArgsB, ModuleInfo, Args).
+ Expansions, ModuleInfo, abstract_inst(Name, Args)) :-
+ inst_list_MSG(ArgsA, ArgsB, Expansions, ModuleInfo, Args).
+inst_MSG_2(not_reached, Inst, _, _, Inst).
+
+:- pred inst_list_MSG(list(inst), list(inst), expansions,
+ module_info, list(inst)).
+:- mode inst_list_MSG(in, in, in, in, out) is semidet.
+
+inst_list_MSG([], [], _, _ModuleInfo, []).
+inst_list_MSG([ArgA | ArgsA], [ArgB | ArgsB], Expansions,
+ ModuleInfo, [Arg | Args]) :-
+ inst_MSG_1(ArgA, ArgB, Expansions, ModuleInfo, Arg),
+ inst_list_MSG(ArgsA, ArgsB, Expansions, ModuleInfo, Args).
% bound_inst_list_MSG(Xs, Ys, ModuleInfo, Zs):
% The two input lists Xs and Ys must already be sorted.
@@ -729,10 +747,10 @@
% Otherwise, the take the msg of the argument insts.
:- pred bound_inst_list_MSG(list(bound_inst), list(bound_inst),
- module_info, uniqueness, list(bound_inst), inst).
-:- mode bound_inst_list_MSG(in, in, in, in, in, out) is semidet.
+ expansions, module_info, uniqueness, list(bound_inst), inst).
+:- mode bound_inst_list_MSG(in, in, in, in, in, in, out) is semidet.
-bound_inst_list_MSG(Xs, Ys, ModuleInfo, Uniq, List, Inst) :-
+bound_inst_list_MSG(Xs, Ys, Expansions, ModuleInfo, Uniq, List, Inst) :-
(
Xs = [],
Ys = []
@@ -744,9 +762,10 @@
X = functor(ConsId, ArgsX),
Y = functor(ConsId, ArgsY)
->
- inst_list_MSG(ArgsX, ArgsY, ModuleInfo, Args),
+ inst_list_MSG(ArgsX, ArgsY, Expansions, ModuleInfo, Args),
Z = functor(ConsId, Args),
- bound_inst_list_MSG(Xs1, Ys1, ModuleInfo, Uniq, List, Inst1),
+ bound_inst_list_MSG(Xs1, Ys1, Expansions,
+ ModuleInfo, Uniq, List, Inst1),
( Inst1 = bound(Uniq, Zs) ->
Inst = bound(Uniq, [Z | Zs])
;
Index: Mmakefile
===================================================================
RCS file: /home/staff/zs/imp/tests/valid/Mmakefile,v
retrieving revision 1.26
diff -u -t -u -r1.26 Mmakefile
--- Mmakefile 1998/10/28 01:52:01 1.26
+++ Mmakefile 1998/11/03 05:06:48
@@ -25,6 +25,7 @@
complicated_unify.m \
constructor_arg_names.m \
dcg_test.m \
+ deforest_loop.m \
det_condition.m \
det_inference.m \
det_switch.m \
@@ -152,6 +153,7 @@
MCFLAGS-two_way_unif = -O-1
MCFLAGS-type_inf_ambig_test = --infer-all
MCFLAGS-vn_float = -O5
+MCFLAGS-deforest_loop = -O3 --intermodule-optimization
# intermod_lambda.m needs inter-module optimization
intermod_lambda.c:
tests/valid/deforest_loop.m
===================================================================
% This test case triggered an infinite loop in deforestation
% in the compiler of 3/11/1998.
:- module deforest_loop.
:- interface.
:- import_module float.
% Lights are modelled as points.
:- type light
---> light(
float, % Power in range [0.0, 1.0].
vec % Position of light.
).
:- type attributes == int.
:- pred shade(scene, ray, ray, attributes, colour).
:- mode shade(in(scene), in, in, in, out) is det.
:- type vec == int.
:- inst scene
---> scene(
list_skel(object),
ground,
ground,
ground,
ground,
ground,
ground
).
:- type scene
---> scene(
list(object), % objects
list(light), % light sources
float, % ambient illumination
float, % coefficient of specular reflection
float, % exponent of specular reflection
float, % focal length of pin-hole camera
colour % background colour
).
:- type colour ---> rgb(float, float, float).
:- type ray == int.
:- type object == pred(int, int).
:- inst object = (pred(in, out) is nondet).
:- implementation.
:- import_module list, math.
shade(Scene, Ray, Intersection, Attributes, Colour) :-
Colour0 = colour(Attributes),
Ambient = scale(ambient(Scene), Colour0),
list__map(shade_from_light(Scene, Ray, Intersection, Colour0),
lights(Scene), Colours),
list__foldl(add_colours, Colours, Ambient, Colour).
:- pred shade_from_light(scene, ray, ray, colour, light, colour).
:- mode shade_from_light(in(scene), in, in, in, in, out) is det.
:- external(shade_from_light/6).
:- func colour(attributes) = colour.
:- external(colour/1).
:- func scale(float, colour) = colour.
scale(F, rgb(R, G, B)) = rgb(range(F * R), range(F * G), range(F * B)).
:- func ambient(scene::in(scene)) = (float::out) is det.
:- external(ambient/1).
:- func lights(scene::in(scene)) = (list(light)::out) is det.
:- external(lights/1).
:- pred add_colours(colour::in, colour::in, colour::out) is det.
add_colours(C0, C1, C0 + C1).
:- func '+'(colour, colour) = colour.
rgb(Ra, Ga, Ba) + rgb(Rb, Gb, Bb) =
rgb(range(Ra + Rb), range(Ga + Gb), range(Ba + Bb)).
:- func range(float) = float.
:- external(range/1).
More information about the developers
mailing list