[m-rev.] diff: Work on bug 130.

[Paul Bone]

Work on Bug 130.

This change adds a test case for bug_130 and modifies the dependant parallel
conjunction transformation to ensure that the test case passes.  This may have
not fixed the bug as the test case might be triggering a different bug than the
one reported.

compiler/dep_par_conj.m:
    Don't perform the dependant parallelisation transformation when the instmap
    after the conjunction is 'unreachable', make these sequential conjunctions.

    Add an extra trace goal to dump the HLDS of the procedure before and after
    the dependant parallel conjunction transformation.

    Improve the output of the existing trace goal by making it also print the
    pred and proc IDs of the procedure it is about to specialise and that this is
    being printed out before specialisation.

tests/par_conj/Mmakefile:
tests/par_conj/bug_130.exp:
tests/par_conj/bug_130.m:
    Add a regression test for bug 130.

Index: compiler/dep_par_conj.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dep_par_conj.m,v
retrieving revision 1.40
diff -u -p -b -r1.40 dep_par_conj.m
--- compiler/dep_par_conj.m	11 Jan 2010 04:27:59 -0000	1.40
+++ compiler/dep_par_conj.m	29 Jan 2010 00:38:22 -0000
@@ -164,6 +164,7 @@
 :- import_module assoc_list.
 :- import_module bool.
 :- import_module int.
+:- import_module io.
 :- import_module map.
 :- import_module maybe.
 :- import_module pair.
@@ -281,12 +282,39 @@ sync_dep_par_conjs_in_proc(PredId, ProcI
         % need to be kept here, this call simply forces an update.
         module_info_rebuild_dependency_info(!ModuleInfo, _),
         
+        GoalBeforeDepParConj = !.Goal,
         !:SyncInfo = sync_info(!.ModuleInfo, IgnoreVars, AllowSomePathsOnly,
             !.VarSet, !.VarTypes, proc(PredId, ProcId)),
         sync_dep_par_conjs_in_goal(!Goal, InstMap0, _, !SyncInfo),
         !.SyncInfo = sync_info(_, _, _, !:VarSet, !:VarTypes, _),
         % XXX RTTI varmaps may need to be updated
 
+        trace [compile_time(flag("debug-dep-par-conj")), io(!IO)] (
+            globals.lookup_accumulating_option(Globals, debug_dep_par_conj,
+                DebugDepParConjWords),
+            PredIdInt = pred_id_to_int(PredId),
+            PredIdStr = string.int_to_string(PredIdInt),
+            (
+                some [DebugDepParConjWord] (
+                    list.member(DebugDepParConjWord, DebugDepParConjWords),
+                    DebugDepParConjWord = PredIdStr
+                )
+            ->
+                OutInfo = init_hlds_out_info(Globals),
+                format("Pred/Proc: %s/%s before dep-par-conj:\n",
+                    [s(string(PredId)), s(string(ProcId))], !IO),
+                write_goal(OutInfo, GoalBeforeDepParConj, !.ModuleInfo,
+                    !.VarSet, yes, 0, "", !IO),
+                nl(!IO),
+                write_string("After dep-par-conj:\n", !IO),
+                write_goal(OutInfo, !.Goal, !.ModuleInfo, !.VarSet,
+                    yes, 0, "", !IO),
+                nl(!IO)
+            ;
+                true
+            )
+        ), 
+
         % We really only need to run this part if something changed, but we
         % only run this predicate on procedures which are likely to have
         % parallel conjunctions.
@@ -317,9 +345,23 @@ sync_dep_par_conjs_in_goal(Goal0, Goal, 
             conj_list_to_goal(Goals, GoalInfo0, Goal)
         ;
             ConjType = parallel_conj,
+            Goal0InstmapDelta = 
+                goal_info_get_instmap_delta(Goal0 ^ hlds_goal_info),
+            ( instmap_delta_is_unreachable(Goal0InstmapDelta) ->
+                % If the instmap becomes unreachable then calculating the
+                % produces and consumers for the dependant parallel conjunction
+                % transformation becomes impossible.  Since this probably
+                % throws an exception anyway there's no point parallelising it.
+                % This should not be a compiler error.  For instance in the
+                % bug_130 test case a call to a deterministic predicate whose
+                % body is erroneous is inlined.  Generating an error in this
+                % case would confuse the programmer.
+                conj_list_to_goal(Goals, GoalInfo0, Goal)
+            ;
             maybe_sync_dep_par_conj(Goals, GoalInfo0, Goal, InstMap0,
                 !SyncInfo)
         )
+        )
     ;
         GoalExpr0 = disj(Goals0),
         sync_dep_par_conjs_in_disj(Goals0, Goals, InstMap0, !SyncInfo),
@@ -1415,8 +1457,11 @@ find_specialization_requests_in_proc(Don
             ->
                 OutInfo = init_hlds_out_info(Globals),
                 proc_info_get_varset(!.ProcInfo, VarSet),
+                format("About to search %d/%d for dependant par conjs:\n",
+                    [i(PredIdInt), i(proc_id_to_int(ProcId))], !IO), 
                 write_goal(OutInfo, !.Goal, !.ModuleInfo, VarSet,
-                    yes, 0, "", !IO)
+                    yes, 0, "", !IO),
+                nl(!IO)
             ;
                 true
             )
Index: tests/par_conj/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/par_conj/Mmakefile,v
retrieving revision 1.18
diff -u -p -b -r1.18 Mmakefile
--- tests/par_conj/Mmakefile	1 Dec 2008 00:32:56 -0000	1.18
+++ tests/par_conj/Mmakefile	29 Jan 2010 00:45:54 -0000
@@ -6,6 +6,7 @@ THIS_DIR = par_conj
 
 # please keep these lists sorted
 DEP_PAR_CONJ_PROGS= \
+	bug_130 \
 	consume_in_some_branches \
 	consume_in_some_branches_and_after \
 	consume_wait \
Index: tests/par_conj/bug_130.exp
===================================================================
RCS file: tests/par_conj/bug_130.exp
diff -N tests/par_conj/bug_130.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/par_conj/bug_130.exp	29 Jan 2010 00:15:30 -0000
@@ -0,0 +1 @@
+state(1, [])
\ No newline at end of file
Index: tests/par_conj/bug_130.m
===================================================================
RCS file: tests/par_conj/bug_130.m
diff -N tests/par_conj/bug_130.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/par_conj/bug_130.m	29 Jan 2010 00:15:30 -0000
@@ -0,0 +1,341 @@
+% Test case for bug 130.  Addapted from the ICFP2000 ray-tracer.
+
+:- module bug_130.
+:- interface.
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+:- import_module int, float, std_util, exception, string.
+:- import_module require.
+:- import_module bool, list, array, map.
+:- import_module pair.
+
+:- type value
+	% base values
+	--->	boolean(bool)
+	;	int(int)
+	;	real(real)
+	;	string(string)
+	% non-base values
+	;	closure(env, code)
+	;	array(array)
+	;	point(point)
+	;	object(object)
+	;	light(light).
+
+:- type point == vector.
+:- type vector ---> point(real, real, real).
+
+:- type color == point. % components restricted to range [0.0, 1.0]
+
+:- type array == array(value).
+
+:- type light
+	--->	directional(
+			dir::vector,
+			directional_intensity::color
+		)
+	;	pointlight(	% Tier 2
+			pointlight_pos::position,
+			pointlight_intensity::color
+		)
+	;	spotlight(	% Tier 3
+			spotlight_pos::position,
+			at::position,
+			spotlight_intensity::color,
+			cutoff::degrees,
+			exp::real
+		).
+
+:- type position == point.
+
+:- type degrees == real.
+
+:- type object_id == int.
+
+	% XXX this is very tentative
+:- type object
+	--->	basic_object(object_id, basic_object, list(light))
+	
+		% XXX should these be applied when they
+		% are found, or done lazily.
+	;	transform(object, transformation)
+
+	;	union(object, object)
+	;	intersect(object, object)	% Tier 3
+	;	difference(object, object)	% Tier 3
+	.
+
+:- inst basic_object_inst == bound( basic_object(ground, ground, ground)).
+
+:- type basic_object	
+	--->	sphere(surface)
+	;	cube(surface)			% Tier 2
+	;	cylinder(surface)		% Tier 2
+	;	cone(surface)			% Tier 2
+	;	plane(surface).
+
+:- type transformation
+	---> 	translate(tx::real, ty::real, tz::real)
+	;	scale(sx::real, sy::real, sz::real)
+	;	uscale(s::real)
+	;	rotatex(rotatex_theta::degrees)
+	;	rotatey(rotatey_theta::degrees)
+	;	rotatez(rotatez_theta::degrees)
+	;	matrix(trans)
+	.
+
+:- type trans
+    --->    trans(matrix, matrix).      % ObjToWorldSpace - WorldToObjSpace.
+
+:- type matrix
+    --->    matrix(
+                float, float, float, float,
+                float, float, float, float,
+                float, float, float, float
+              % 0,    0,    0,    1
+            ).
+
+:- type surface
+	--->	surface(env, code)		% The surface function
+	;	constant(surface_properties).	% surface function is constant
+
+:- type surface_properties --->
+	surface_properties(
+		surface_c :: color,
+		surface_kd :: real,		% diffuse reflection coeff
+		surface_ks :: real,		% specular reflection coeff
+		surface_n :: real		% Phong exp
+	).
+
+    % Interpreter state.
+    %
+:- type state
+    --->    state(
+        s_global_object_counter     :: object_id,
+        s_render_commands           :: list(render_params)
+    ).
+
+:- type render_params
+    ---> render_params(
+        amb :: color,        % the ambient light
+        lights :: array,    % array(light)
+        scene :: scene,        % the scene to render
+        depth :: int,
+        fov :: real,        % the field of view
+        wid :: int,        % the width, in pixels
+        ht :: int,        % the height, in pixels
+        file :: string
+    ).
+
+:- type real == float.
+
+:- type scene
+	---> scene(
+		space_tree,
+		list(object)	% objects which can't be partitioned
+				% (e.g. planes)
+	).
+
+:- type space_tree
+	---> 	space_tree(
+			bounding_box,
+			surface_area,
+			list(space_tree_node)
+		).
+
+:- type space_tree_node
+	--->	node(
+			space_tree
+		)
+	;
+		leaf(
+			space_tree_object
+		)	
+	.
+
+:- type space_tree_object
+	--->	space_tree_object(
+			bounding_box,
+			surface_area,
+			object
+		).
+
+:- type surface_area == real.
+:- type bounding_box == pair(point).
+
+:- func new_interpreter_state = bug_130.state.
+
+:- type env == map(id, value).
+
+:- type id == string.
+
+:- type stack == list(value).
+
+:- type token_list == list(token_group).
+
+:- type token_group
+	--->	single_token(token)
+	;	function(token_list)
+	;	array(token_list).
+
+:- type token
+	--->	operator(operator)
+	;	identifier(string)
+	;	binder(string)
+	;	boolean(bool)
+	;	number(number)
+	;	string(string)
+		
+		% Not part of the spec
+		% these are extra operators which make interpretation
+		% more efficient.
+	;	extra(extra_operator).
+
+:- type operator
+	--->	acos
+	;	addi
+	;	addf
+	;	apply
+	;	asin
+	;	clampf
+	;	cone			% Tier-2
+	;	cos
+	;	cube			% Tier-2
+	;	cylinder		% Tier-2
+	;	difference		% Tier-3
+	;	divi
+	;	divf
+	;	eqi
+	;	eqf
+	;	floor
+	;	frac
+	;	get
+	;	getx
+	;	gety
+	;	getz
+	;	(if)
+	;	intersect		% Tier-3
+	;	length
+	;	lessi
+	;	lessf
+	;	light
+	;	modi
+	;	muli
+	;	mulf
+	;	negi
+	;	negf
+	;	plane
+	;	point
+	;	pointlight		% Tier-2
+	;	real
+	;	render
+	;	rotatex
+	;	rotatey
+	;	rotatez
+	;	scale
+	;	sin
+	;	sphere
+	;	spotlight		% Tier-3
+	;	sqrt
+	;	subi
+	;	subf
+	;	translate
+	;	union
+	;	uscale
+	.
+
+:- type number
+	--->	integer(int)
+	;	real(float).
+
+:- type extra_operator
+	--->	popn(int)		% discard top n elements of stack
+	;	dup			% duplicate the topmost element
+	;	constant_sphere(
+			surface_properties
+		)
+	;	constant_plane(
+			surface_properties
+		)
+	;	constant_cone(
+			surface_properties
+		)
+	;	constant_cube(
+			surface_properties
+		)
+	;	constant_cylinder(
+			surface_properties
+		)
+	;	constant_point(
+			point
+		)
+			% an `if' whose arms are just constants
+	;	constant_if(
+			value,
+			value
+		)
+	;	mercury_closure(
+			pred(env, stack,
+				env, stack,
+				bug_130.state, bug_130.state
+			)
+		)
+	.
+
+:- type code == token_list.
+
+	% Some exceptions we might throw.
+:- type stack_env_exception --->
+	stack_env_exception(string, env, stack).
+
+:- type stack_env_token_exception --->
+	stack_env_token_exception(string, env, stack, token).
+
+	% An error in the program itself.
+:- type program_error 
+	---> 	program_error(string) 
+	;	program_error(string, stack).
+
+
+main(!IO) :-
+    State0 = new_interpreter_state,
+    interpret([], State0, State),
+    io.write(State, !IO).
+
+new_interpreter_state = 
+    state(
+        1,      % Global object counter
+        []      % Render commands.
+    ).
+
+:- pred interpret(code::in, bug_130.state::in, bug_130.state::out) is det.
+
+interpret(Code, !State) :-
+    map__init(Env0),
+    Stack0 = [],
+	interpret(Code, Env0, Stack0, _Env, _Stack, !State).
+
+:- pred interpret(code::in, env::in, stack::in, env::out, stack::out,
+    bug_130.state::in, bug_130.state::out) is det.
+
+interpret([], Env, Stack, Env, Stack) --> [].
+interpret(Tokens0, Env0, Stack0, Env, Stack) -->
+    { Tokens0 = [Token | Tokens] },
+    (
+        do_token_group(Token, Env0, Stack0, Env1, Stack1)
+    &
+	    interpret(Tokens, Env1, Stack1, Env, Stack)
+    ).
+
+:- pred do_token_group(token_group::in, env::in, stack::in,
+		env::out, stack::out, bug_130.state::in, bug_130.state::out) 
+    is det.
+
+do_token_group(_, Env, Stack, Env, Stack, State, State) :-
+    error("Predicate not implemented").
+
-------------- next part --------------
A non-text attachment was scrubbed...
Name: signature.asc
Type: application/pgp-signature
Size: 489 bytes
Desc: Digital signature
URL: <http://lists.mercurylang.org/archives/reviews/attachments/20100129/6542e167/attachment.sig>