[m-rev.] For review: Fix bug 130
Paul Bone
pbone at csse.unimelb.edu.au
Mon Feb 8 15:45:09 AEDT 2010
For review by Zoltan.
Note that I havn't yet told CVS to remove bug_130.{m,exp} so it is not shown in
the diff.
Thanks.
Fix bug 130.
compiler/par_conj_dep.m:
Check the determinism of goals before inserting a signal in them of testing
if we should insert a signal in them.
Create a new constructor symbol in the cost_after_signal type that is
returned by should_we_push_signal when the code that we would normally
insert a signal into is unreachable.
Use an instantiation sub type to list the values of cost_after_signal that
are valid inputs to the should_we_push_signal predicate.
In should_we_push_signal: Replace some if-then-else goals with switches,
this ensures that the determinism checker can alert us when there are
uncovered values in the switches.
Merge the results of should_we_push_signal after branching code.
tests/par_conj/bug_130_unreachable.m:
This was originally bug_130.m except that it doesn't test for bug 130 but a
similar bug with the same symptom.
Simplified this test case, this still triggers the bug in unpatched
compilers.
tests/par_conj/bug_130_unreachable.exp:
The expected output for bug_130_unreachable.
tests/par_conj/bug_130_should_push_signal.m:
tests/par_conj/bug_130_should_push_signal.exp:
Discovered another bug when should_we_push_signal/4 seems to get confused
around erroneous code.
tests/par_conj/bug_130.m:
tests/par_conj/bug_130.exp:
Removed this test case since it's a duplicate of bug_130_unreachable.
Index: compiler/dep_par_conj.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dep_par_conj.m,v
retrieving revision 1.41
diff -u -p -b -r1.41 dep_par_conj.m
--- compiler/dep_par_conj.m 29 Jan 2010 00:53:04 -0000 1.41
+++ compiler/dep_par_conj.m 8 Feb 2010 04:36:48 -0000
@@ -1008,17 +1008,24 @@ insert_wait_in_cases(ModuleInfo, AllowSo
insert_signal_in_goal(ModuleInfo, FutureMap, ProducedVar,
Goal0, Goal, !VarSet, !VarTypes) :-
Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
+ Detism = goal_info_get_determinism(GoalInfo0),
+ determinism_components(Detism, _CanFail, NumSolutions),
+ (
+ ( NumSolutions = at_most_one
+ ; NumSolutions = at_most_many_cc
+ ; NumSolutions = at_most_many
+ ),
( var_in_nonlocals(ProducedVar, Goal0) ->
(
GoalExpr0 = conj(ConjType, Goals0),
(
ConjType = plain_conj,
- insert_signal_in_plain_conj(ModuleInfo, FutureMap, ProducedVar,
- Goals0, Goals, !VarSet, !VarTypes)
+ insert_signal_in_plain_conj(ModuleInfo, FutureMap,
+ ProducedVar, Goals0, Goals, !VarSet, !VarTypes)
;
ConjType = parallel_conj,
- insert_signal_in_par_conj(ModuleInfo, FutureMap, ProducedVar,
- Goals0, Goals, !VarSet, !VarTypes)
+ insert_signal_in_par_conj(ModuleInfo, FutureMap,
+ ProducedVar, Goals0, Goals, !VarSet, !VarTypes)
),
GoalExpr = conj(ConjType, Goals),
Goal = hlds_goal(GoalExpr, GoalInfo0)
@@ -1055,11 +1062,11 @@ insert_signal_in_goal(ModuleInfo, Future
GoalExpr0 = scope(Reason, SubGoal0),
( Reason = from_ground_term(_, from_ground_term_construct) ->
% Pushing the signal into the scope would invalidate the
- % invariant that from_ground_term_construct scopes do nothing
- % except construct a ground term. It would also be pointless,
- % since the code generator will turn the entire scope into a
- % single assignment statement. We therefore put he signal
- % *after* the scope.
+ % invariant that from_ground_term_construct scopes do
+ % nothing except construct a ground term. It would also be
+ % pointless, since the code generator will turn the entire
+ % scope into a single assignment statement. We therefore
+ % put he signal *after* the scope.
insert_signal_after_goal(ModuleInfo, FutureMap, ProducedVar,
Goal0, Goal, !VarSet, !VarTypes)
;
@@ -1072,18 +1079,18 @@ insert_signal_in_goal(ModuleInfo, Future
SubMaxSolns0 = at_most_many,
MaxSolns0 \= at_most_many
->
- % The value of ProducedVar is not stable inside SubGoal0,
- % i.e. SubGoal0 can generate a value for ProducedVar and
- % then backtrack over the goal that generated it. In such
- % cases, we can signal the availability of ProducedVar
- % only when it has become stable, which is when the scope
- % has cut away any possibility of further backtracking
- % inside SubGoal0.
- insert_signal_after_goal(ModuleInfo, FutureMap, ProducedVar,
- Goal0, Goal, !VarSet, !VarTypes)
+ % The value of ProducedVar is not stable inside
+ % SubGoal0, i.e. SubGoal0 can generate a value for
+ % ProducedVar and then backtrack over the goal that
+ % generated it. In such cases, we can signal the
+ % availability of ProducedVar only when it has become
+ % stable, which is when the scope has cut away any
+ % possibility of further backtracking inside SubGoal0.
+ insert_signal_after_goal(ModuleInfo, FutureMap,
+ ProducedVar, Goal0, Goal, !VarSet, !VarTypes)
;
- insert_signal_in_goal(ModuleInfo, FutureMap, ProducedVar,
- SubGoal0, SubGoal, !VarSet, !VarTypes),
+ insert_signal_in_goal(ModuleInfo, FutureMap,
+ ProducedVar, SubGoal0, SubGoal, !VarSet, !VarTypes),
GoalExpr = scope(Reason, SubGoal),
Goal = hlds_goal(GoalExpr, GoalInfo0)
)
@@ -1101,17 +1108,17 @@ insert_signal_in_goal(ModuleInfo, Future
unexpected(this_file, "insert_signal_in_goal: shorthand")
)
;
- % When inserting waits into a goal, it is ok for the goal not to
- % mention the consumed variable, but when inserting signals into a
- % goal, the goal must produce the variable if it succeeds, so if
- % the goal does not mention the variable, it cannot succeed.
- Detism = goal_info_get_determinism(GoalInfo0),
- determinism_components(Detism, _CanFail, SolnCount),
- expect(unify(SolnCount, at_most_zero), this_file,
- "insert_signal_in_goal: ProducedVar is not in nonlocals"),
-
- % There would be no point in adding a signal to the end of Goal0,
- % since execution cannot get there.
+ % We expected this goal to produce the variable that we're looking
+ % for.
+ unexpected(this_file,
+ "insert_signal_in_goal: ProducedVar is not in nonlocals")
+ )
+ ;
+ NumSolutions = at_most_zero,
+ % We don't bother pushing signals into code that has no solutions.
+ % Note that we can't call unexpected here since we could be trying to
+ % push a signal into a procedure during specialisation. We must fail
+ % gracefully.
Goal = Goal0
).
@@ -2191,6 +2198,11 @@ should_we_push_test(PredProcId, ArgPos,
;
CostAfterSignal = seen_signal_non_negligible_cost_after,
IsWorthPushing = worth_pushing
+ ;
+ CostAfterSignal = signal_could_be_unreachable,
+ % The signal will never be executed no matter where we put it,
+ % don't bother specialising code.
+ IsWorthPushing = not_worth_pushing
)
).
@@ -2460,10 +2472,19 @@ should_we_push_wait_in_cases(Var, [Case
:- type cost_after_signal
---> not_seen_signal
+ ; signal_could_be_unreachable
; seen_signal_negligible_cost_after
; seen_signal_non_negligible_cost_after.
-:- pred seen_produced_var(cost_after_signal::in, cost_after_signal::out)
+ % The should we signal code only makes sense when it's input is one of
+ % these values for !.Signal.
+ %
+:- inst cost_after_signal_in
+ ---> not_seen_signal
+ ; seen_signal_negligible_cost_after.
+
+:- pred seen_produced_var(cost_after_signal::in(cost_after_signal_in),
+ cost_after_signal::out)
is det.
seen_produced_var(!Signal) :-
@@ -2471,13 +2492,11 @@ seen_produced_var(!Signal) :-
!.Signal = not_seen_signal,
!:Signal = seen_signal_negligible_cost_after
;
- ( !.Signal = seen_signal_negligible_cost_after
- ; !.Signal = seen_signal_non_negligible_cost_after
- )
+ !.Signal = seen_signal_negligible_cost_after
).
-:- pred seen_nontrivial_cost(cost_after_signal::in, cost_after_signal::out)
- is det.
+:- pred seen_nontrivial_cost(cost_after_signal::in(cost_after_signal_in),
+ cost_after_signal::out) is det.
seen_nontrivial_cost(!Signal) :-
(
@@ -2486,25 +2505,29 @@ seen_nontrivial_cost(!Signal) :-
;
!.Signal = seen_signal_negligible_cost_after,
!:Signal = seen_signal_non_negligible_cost_after
- ;
- !.Signal = seen_signal_non_negligible_cost_after
).
:- pred should_we_push_signal(prog_var::in, hlds_goal::in,
- cost_after_signal::in, cost_after_signal::out) is det.
+ cost_after_signal::in(cost_after_signal_in), cost_after_signal::out)
+ is det.
should_we_push_signal(Var, Goal, !Signal) :-
- expect(negate(unify(!.Signal, seen_signal_non_negligible_cost_after)),
- this_file, "should_we_push_signal: already know we want to push"),
Goal = hlds_goal(GoalExpr, GoalInfo),
+ Detism = goal_info_get_determinism(GoalInfo),
+ determinism_components(Detism, _CanFail, NumSolutions),
+ (
+ ( NumSolutions = at_most_one
+ ; NumSolutions = at_most_many_cc
+ ; NumSolutions = at_most_many
+ ),
NonLocals = goal_info_get_nonlocals(GoalInfo),
- % When handling calls, we could use profiling data to decide whether
- % a call site has negligible cost or not. In the absence of such data,
- % we have to assume that all call sites have non-negligible cost, because
- % if we assumed that they have negligible cost, then we would have to infer
- % that *all* goals have negligible cost, which besides being incorrect,
- % would mean that there is never any point in pushing signals, rendering
- % this entire code useless.
+ % When handling calls, we could use profiling data to decide whether a
+ % call site has negligible cost or not. In the absence of such data, we
+ % have to assume that all call sites have non-negligible cost, because
+ % if we assumed that they have negligible cost, then we would have to
+ % infer that *all* goals have negligible cost, which besides being
+ % incorrect, would mean that there is never any point in pushing
+ % signals, rendering this entire code useless.
(
GoalExpr = unify(_, _, _, _, _),
( set.member(Var, NonLocals) ->
@@ -2546,13 +2569,13 @@ should_we_push_signal(Var, Goal, !Signal
)
;
GoalExpr = disj(Disjuncts),
- % What we do in this case doesn't usually matter. Semidet disjunctions
- % cannot bind any nonlocal variables (and thus cannot bind Var).
- % Nondet disjunctions can bind variables, but we want to parallelize
- % only model_det code. The only case where what we do here matters
- % is when a nondet disjunction is inside a scope that commits to the
- % first success.
- should_we_push_signal_in_disj(Var, Disjuncts, !.Signal, !Signal)
+ % What we do in this case doesn't usually matter. Semidet
+ % disjunctions cannot bind any nonlocal variables (and thus cannot
+ % bind Var). Nondet disjunctions can bind variables, but we want
+ % to parallelize only model_det code. The only case where what we
+ % do here matters is when a nondet disjunction is inside a scope
+ % that commits to the first success.
+ should_we_push_signal_in_disj(Var, Disjuncts, !Signal)
;
GoalExpr = switch(SwitchVar, _, Cases),
( Var = SwitchVar ->
@@ -2560,7 +2583,7 @@ should_we_push_signal(Var, Goal, !Signal
expect(negate(unify(!.Signal, not_seen_signal)),
this_file, "should_we_push_signal: not seen switch var")
;
- should_we_push_signal_in_cases(Var, Cases, !.Signal, !Signal)
+ should_we_push_signal_in_cases(Var, Cases, !Signal)
)
;
GoalExpr = if_then_else(_Vars, _Cond, Then, Else),
@@ -2568,51 +2591,50 @@ should_we_push_signal(Var, Goal, !Signal
should_we_push_signal(Var, Then, !.Signal, SignalThen),
should_we_push_signal(Var, Else, !.Signal, SignalElse),
(
- ( SignalThen = seen_signal_non_negligible_cost_after
- ; SignalElse = seen_signal_non_negligible_cost_after
- )
- ->
- % It is worth pushing the signal into at least one of the then and
- % else cases.
- !:Signal = seen_signal_non_negligible_cost_after
+ SignalThen = not_seen_signal,
+ (
+ ( SignalElse = not_seen_signal
+ ; SignalElse = signal_could_be_unreachable
+ ),
+ !:Signal = not_seen_signal
;
- ( SignalThen = seen_signal_negligible_cost_after
+ ( SignalElse = seen_signal_non_negligible_cost_after
; SignalElse = seen_signal_negligible_cost_after
+ ),
+ unexpected(this_file, "should_we_push_signal: " ++
+ "ITE is not mode safe")
)
- ->
+ ;
+ SignalThen = signal_could_be_unreachable,
+ !:Signal = SignalElse
+ ;
+ SignalThen = seen_signal_non_negligible_cost_after,
(
- Then = hlds_goal(_, ThenInfo),
- ThenDetism = goal_info_get_determinism(ThenInfo),
- determinism_components(ThenDetism, _, ThenMaxSolns),
- SignalThen = not_seen_signal,
- not ( ThenMaxSolns = at_most_zero)
- ->
- unexpected(this_file,
- "should_we_push_signal: ite mode mismatch")
+ SignalElse = not_seen_signal,
+ unexpected(this_file, "should_we_push_signal: " ++
+ "ITE is not mode safe")
;
- true
+ ( SignalElse = signal_could_be_unreachable
+ ; SignalElse = seen_signal_non_negligible_cost_after
+ ; SignalElse = seen_signal_negligible_cost_after
),
+ !:Signal = seen_signal_non_negligible_cost_after
+ )
+ ;
+ SignalThen = seen_signal_negligible_cost_after,
(
- Else = hlds_goal(_, ElseInfo),
- ElseDetism = goal_info_get_determinism(ElseInfo),
- determinism_components(ElseDetism, _, ElseMaxSolns),
SignalElse = not_seen_signal,
- not ( ElseMaxSolns = at_most_zero)
- ->
- unexpected(this_file,
- "should_we_push_signal: ite mode mismatch")
+ unexpected(this_file, "should_we_push_signal: " ++
+ "ITE is not mode safe")
;
- true
+ ( SignalElse = signal_could_be_unreachable
+ ; SignalElse = seen_signal_negligible_cost_after
),
- % Both arms of the if-then-else signal Var (if they succeed
- % at all), but neither does anything nontrivial after the signal.
!:Signal = seen_signal_negligible_cost_after
;
- expect(unify(SignalThen, not_seen_signal),
- this_file, "should_we_push_signal: ite not_seen_signal"),
- expect(unify(SignalElse, not_seen_signal),
- this_file, "should_we_push_signal: ite not_seen_signal"),
- !:Signal = not_seen_signal
+ SignalElse = seen_signal_non_negligible_cost_after,
+ !:Signal = seen_signal_non_negligible_cost_after
+ )
)
;
GoalExpr = negation(SubGoal),
@@ -2625,9 +2647,6 @@ should_we_push_signal(Var, Goal, !Signal
!.Signal = seen_signal_negligible_cost_after,
% We do care whether the cost of SubGoal is negligible or not.
should_we_push_signal(Var, SubGoal, !Signal)
- ;
- !.Signal = seen_signal_non_negligible_cost_after,
- unexpected(this_file, "seen_signal_non_negligible_cost_after")
)
;
GoalExpr = scope(Reason, SubGoal),
@@ -2643,10 +2662,19 @@ should_we_push_signal(Var, Goal, !Signal
;
GoalExpr = shorthand(_),
unexpected(this_file, "should_we_push_signal: shorthand")
+ )
+ ;
+ NumSolutions = at_most_zero,
+ % The goal can never complete, which means that it can never produce
+ % the future and has an 'unreachable' instmap. Note that we haven't
+ % checked that this goal or a goal after it definitely produce the
+ % variable.
+ !:Signal = signal_could_be_unreachable
).
:- pred should_we_push_signal_in_plain_conj(prog_var::in, list(hlds_goal)::in,
- cost_after_signal::in, cost_after_signal::out) is det.
+ cost_after_signal::in(cost_after_signal_in), cost_after_signal::out)
+ is det.
should_we_push_signal_in_plain_conj(_Var, [], !Signal).
should_we_push_signal_in_plain_conj(Var, [Conjunct | Conjuncts], !Signal) :-
@@ -2656,6 +2684,9 @@ should_we_push_signal_in_plain_conj(Var,
% There is no point in looking at Conjuncts; we already know
% we want to push the signal.
;
+ !.Signal = signal_could_be_unreachable
+ % We don't bother checking if the signal occurs in unreachable code.
+ ;
( !.Signal = not_seen_signal
; !.Signal = seen_signal_negligible_cost_after
),
@@ -2663,8 +2694,8 @@ should_we_push_signal_in_plain_conj(Var,
).
:- pred should_we_push_signal_in_par_conj(prog_var::in, list(hlds_goal)::in,
- cost_after_signal::in, cost_after_signal::in, cost_after_signal::out)
- is det.
+ cost_after_signal::in(cost_after_signal_in),
+ cost_after_signal::in, cost_after_signal::out) is det.
should_we_push_signal_in_par_conj(_Var, [], _OrigSignal, !FinalSignal).
should_we_push_signal_in_par_conj(Var, [Conjunct | Conjuncts], OrigSignal,
@@ -2678,6 +2709,9 @@ should_we_push_signal_in_par_conj(Var, [
should_we_push_signal_in_par_conj(Var, Conjuncts, OrigSignal,
!FinalSignal)
;
+ ConjunctSignal = signal_could_be_unreachable,
+ !:FinalSignal = signal_could_be_unreachable
+ ;
ConjunctSignal = seen_signal_negligible_cost_after,
(
Conjuncts = [],
@@ -2703,56 +2737,96 @@ should_we_push_signal_in_par_conj(Var, [
"should_we_push_signal_in_par_conj: final signal goes backwards").
:- pred should_we_push_signal_in_disj(prog_var::in, list(hlds_goal)::in,
- cost_after_signal::in, cost_after_signal::in, cost_after_signal::out)
- is det.
+ cost_after_signal::in(cost_after_signal_in),
+ cost_after_signal::out) is det.
-should_we_push_signal_in_disj(_Var, [], _OrigSignal, !FinalSignal).
+should_we_push_signal_in_disj(_Var, [], _OrigSignal, signal_could_be_unreachable).
should_we_push_signal_in_disj(Var, [FirstGoal | LaterGoals], OrigSignal,
- _, !:FinalSignal) :-
+ Signal) :-
should_we_push_signal(Var, FirstGoal, OrigSignal, SignalFirst),
(
SignalFirst = not_seen_signal,
% If FirstGoal does not signal Var, the rest of the disjuncts
% shouldn't either.
- !:FinalSignal = SignalFirst
+ Signal = SignalFirst
;
SignalFirst = seen_signal_non_negligible_cost_after,
% We already know we want to push the signal.
- !:FinalSignal = SignalFirst
+ Signal = SignalFirst
;
- SignalFirst = seen_signal_negligible_cost_after,
+ ( SignalFirst = seen_signal_negligible_cost_after
+ ; SignalFirst = signal_could_be_unreachable
+ ),
% We want to push the signal only if it is worth pushing
% into one of the the rest of the disjuncts.
- !:FinalSignal = SignalFirst,
should_we_push_signal_in_disj(Var, LaterGoals, OrigSignal,
- !FinalSignal)
+ Signal0),
+ (
+ SignalFirst = seen_signal_negligible_cost_after,
+ (
+ Signal0 = not_seen_signal,
+ unexpected(this_file, "should_we_push_signal_in_disj: " ++
+ "The program doesn't seem mode correct")
+ ;
+ Signal0 = signal_could_be_unreachable,
+ Signal = SignalFirst
+ ;
+ ( Signal0 = seen_signal_negligible_cost_after
+ ; Signal0 = seen_signal_non_negligible_cost_after
+ ),
+ Signal = Signal0
+ )
+ ;
+ SignalFirst = signal_could_be_unreachable,
+ Signal = Signal0
+ )
).
:- pred should_we_push_signal_in_cases(prog_var::in, list(case)::in,
- cost_after_signal::in, cost_after_signal::in, cost_after_signal::out)
- is det.
+ cost_after_signal::in(cost_after_signal_in),
+ cost_after_signal::out) is det.
-should_we_push_signal_in_cases(_Var, [], _OrigSignal, !FinalSignal).
+should_we_push_signal_in_cases(_Var, [], _OrigSignal, signal_could_be_unreachable).
should_we_push_signal_in_cases(Var, [FirstCase | LaterCases], OrigSignal,
- _, !:FinalSignal) :-
+ Signal) :-
FirstCase = case(_, _, FirstGoal),
should_we_push_signal(Var, FirstGoal, OrigSignal, SignalFirst),
(
SignalFirst = not_seen_signal,
% If FirstCase does not signal Var, the rest of the cases
% shouldn't either.
- !:FinalSignal = SignalFirst
+ Signal = SignalFirst
;
SignalFirst = seen_signal_non_negligible_cost_after,
% We already know we want to push the signal.
- !:FinalSignal = SignalFirst
+ Signal = SignalFirst
;
- SignalFirst = seen_signal_negligible_cost_after,
+ ( SignalFirst = seen_signal_negligible_cost_after
+ ; SignalFirst = signal_could_be_unreachable
+ ),
% We want to push the signal only if it is worth pushing
% into one of the the rest of the cases.
- !:FinalSignal = SignalFirst,
should_we_push_signal_in_cases(Var, LaterCases, OrigSignal,
- !FinalSignal)
+ Signal0),
+ (
+ SignalFirst = seen_signal_negligible_cost_after,
+ (
+ Signal0 = not_seen_signal,
+ unexpected(this_file, "should_we_push_signal_in_cases: " ++
+ "The program doesn't seem mode correct")
+ ;
+ Signal0 = signal_could_be_unreachable,
+ Signal = SignalFirst
+ ;
+ ( Signal0 = seen_signal_negligible_cost_after
+ ; Signal0 = seen_signal_non_negligible_cost_after
+ ),
+ Signal = Signal0
+ )
+ ;
+ SignalFirst = signal_could_be_unreachable,
+ Signal = Signal0
+ )
).
:- pred seen_more_signal(cost_after_signal::in, cost_after_signal::in)
@@ -2764,15 +2838,27 @@ seen_more_signal(SignalA, SignalB) :-
:- func seen_more_signal_2(cost_after_signal, cost_after_signal) = bool.
seen_more_signal_2(not_seen_signal, _) = yes.
+seen_more_signal_2(signal_could_be_unreachable,
+ not_seen_signal) = no.
+seen_more_signal_2(signal_could_be_unreachable,
+ signal_could_be_unreachable) = yes.
+seen_more_signal_2(signal_could_be_unreachable,
+ seen_signal_negligible_cost_after) = no.
+seen_more_signal_2(signal_could_be_unreachable,
+ seen_signal_non_negligible_cost_after) = no.
seen_more_signal_2(seen_signal_negligible_cost_after,
not_seen_signal) = no.
seen_more_signal_2(seen_signal_negligible_cost_after,
+ signal_could_be_unreachable) = yes.
+seen_more_signal_2(seen_signal_negligible_cost_after,
seen_signal_negligible_cost_after) = yes.
seen_more_signal_2(seen_signal_negligible_cost_after,
seen_signal_non_negligible_cost_after) = yes.
seen_more_signal_2(seen_signal_non_negligible_cost_after,
not_seen_signal) = no.
seen_more_signal_2(seen_signal_non_negligible_cost_after,
+ signal_could_be_unreachable) = yes.
+seen_more_signal_2(seen_signal_non_negligible_cost_after,
seen_signal_negligible_cost_after) = no.
seen_more_signal_2(seen_signal_non_negligible_cost_after,
seen_signal_non_negligible_cost_after) = yes.
Index: tests/par_conj/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/par_conj/Mmakefile,v
retrieving revision 1.19
diff -u -p -b -r1.19 Mmakefile
--- tests/par_conj/Mmakefile 29 Jan 2010 00:53:05 -0000 1.19
+++ tests/par_conj/Mmakefile 8 Feb 2010 04:28:32 -0000
@@ -6,7 +6,8 @@ THIS_DIR = par_conj
# please keep these lists sorted
DEP_PAR_CONJ_PROGS= \
- bug_130 \
+ bug_130_unreachable \
+ bug_130_should_push_signal \
consume_in_some_branches \
consume_in_some_branches_and_after \
consume_wait \
Index: tests/par_conj/bug_130_should_push_signal.exp
===================================================================
RCS file: tests/par_conj/bug_130_should_push_signal.exp
diff -N tests/par_conj/bug_130_should_push_signal.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/par_conj/bug_130_should_push_signal.exp 8 Feb 2010 04:28:32 -0000
@@ -0,0 +1 @@
+state(1, [])
\ No newline at end of file
Index: tests/par_conj/bug_130_should_push_signal.m
===================================================================
RCS file: tests/par_conj/bug_130_should_push_signal.m
diff -N tests/par_conj/bug_130_should_push_signal.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/par_conj/bug_130_should_push_signal.m 8 Feb 2010 04:38:05 -0000
@@ -0,0 +1,126 @@
+% Test case for bug 130. Adapted from the ICFP2000 ray-tracer.
+
+:- module bug_130_should_push_signal.
+:- 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, map.
+:- import_module pair.
+
+:- type value
+ % base values
+ ---> boolean(bool)
+ ; int(int)
+ ; real(real)
+ ; string(string)
+ % non-base values
+ ; closure(env, code).
+
+:- type object_id == int.
+
+ % Interpreter state.
+ %
+:- type my_state
+ ---> state(
+ s_global_object_counter :: object_id,
+ s_render_commands :: list(render_params)
+ ).
+
+:- type render_params
+ ---> render_params(
+ 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 env == map(id, value).
+
+:- type id == string.
+
+:- type stack == list(value).
+
+:- type token_list == list(token_group).
+
+:- type token_group
+ ---> single_token(token)
+ ; two_tokens(token, token).
+
+:- type token
+ ---> identifier(string)
+ ; binder(string)
+ ; boolean(bool)
+ ; number(number)
+ ; string(string).
+
+:- type number
+ ---> integer(int)
+ ; real(float).
+
+:- type code == token_list.
+
+main(!IO) :-
+ State0 = new_interpreter_state,
+ interpret([], State0, State),
+ io.write(State, !IO).
+
+:- func new_interpreter_state = my_state.
+
+new_interpreter_state =
+ state(
+ 1, % Global object counter
+ [] % Render commands.
+ ).
+
+:- pred interpret(code::in, my_state::in, my_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,
+ my_state::in, my_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)
+ ).
+
+:- pragma no_inline(do_token_group/7).
+
+:- pred do_token_group(token_group::in, env::in, stack::in,
+ env::out, stack::out, my_state::in, my_state::out)
+ is det.
+
+do_token_group(TokenGroup, Env0, Stack0, Env, Stack, !State) :-
+ (
+ TokenGroup = single_token(Token),
+ do_token(Token, Env0, Stack0, Env, Stack, !State)
+ ;
+ TokenGroup = two_tokens(_TokenA, _TokenB),
+ error("")
+ ).
+
+:- pred do_token(token::in, env::in, stack::in,
+ env::out, stack::out, my_state::in, my_state::out)
+ is det.
+
+do_token(_, Env, Stack, Env, Stack, !State) :-
+ !:State = !.State ^ s_global_object_counter :=
+ !.State ^ s_global_object_counter + 1.
+
Index: tests/par_conj/bug_130_unreachable.exp
===================================================================
RCS file: tests/par_conj/bug_130_unreachable.exp
diff -N tests/par_conj/bug_130_unreachable.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/par_conj/bug_130_unreachable.exp 8 Feb 2010 04:28:32 -0000
@@ -0,0 +1 @@
+state(1, [])
\ No newline at end of file
Index: tests/par_conj/bug_130_unreachable.m
===================================================================
RCS file: tests/par_conj/bug_130_unreachable.m
diff -N tests/par_conj/bug_130_unreachable.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/par_conj/bug_130_unreachable.m 8 Feb 2010 04:38:22 -0000
@@ -0,0 +1,113 @@
+% Test case for bug 130. Adapted from the ICFP2000 ray-tracer.
+
+% This test case tests for a bug with the same symptoms as bug 130, but it's
+% not actually bug 130.
+
+:- module bug_130_unreachable.
+:- 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, map.
+:- import_module pair.
+
+:- type value
+ % base values
+ ---> boolean(bool)
+ ; int(int)
+ ; real(real)
+ ; string(string)
+ % non-base values
+ ; closure(env, code).
+
+:- type object_id == int.
+
+ % Interpreter state.
+ %
+:- type state
+ ---> state(
+ s_global_object_counter :: object_id,
+ s_render_commands :: list(render_params)
+ ).
+
+:- type render_params
+ ---> render_params(
+ 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 env == map(id, value).
+
+:- type id == string.
+
+:- type stack == list(value).
+
+:- type token_list == list(token_group).
+
+:- type token_group
+ ---> single_token(token).
+
+:- type token
+ ---> identifier(string)
+ ; binder(string)
+ ; boolean(bool)
+ ; number(number)
+ ; string(string).
+
+:- type number
+ ---> integer(int)
+ ; real(float).
+
+:- type code == token_list.
+
+main(!IO) :-
+ State0 = new_interpreter_state,
+ interpret([], State0, State),
+ io.write(State, !IO).
+
+:- func new_interpreter_state = bug_130_unreachable.state.
+
+new_interpreter_state =
+ state(
+ 1, % Global object counter
+ [] % Render commands.
+ ).
+
+:- pred interpret(code::in,
+ bug_130_unreachable.state::in, bug_130_unreachable.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_unreachable.state::in, bug_130_unreachable.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_unreachable.state::in, bug_130_unreachable.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/20100208/11ca024a/attachment.sig>
More information about the reviews
mailing list