[m-rev.] for review: fix problem reported by Sebastian

[Zoltan Somogyi]

This is for both branches.

Zoltan.

compiler/constraint.m:
	Don't push constraints into scopes where they could change the meaning
	of the scope.

	Turn the predicate into a single disjunction to make the head variables
	meaningful (and consistent) names in the debugger.

tests/Mmakefile:
	Compile the one_member test case with -O5, since the old bug in
	constraint.m doesn't manifest itself at the default optimization level.

cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/constraint.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/constraint.m,v
retrieving revision 1.73
diff -u -b -r1.73 constraint.m
--- compiler/constraint.m	29 Mar 2006 08:06:39 -0000	1.73
+++ compiler/constraint.m	6 Apr 2006 06:03:14 -0000
@@ -127,35 +127,34 @@
     list(hlds_goal)::out, constraint_info::in, constraint_info::out,
     io::di, io::uo) is det.
 
-propagate_conj_sub_goal_2(conj(ConjType, Goals0) - GoalInfo, Constraints0,
-        [conj(ConjType, Goals) - GoalInfo | MoreGoals], !Info, !IO) :-
+propagate_conj_sub_goal_2(GoalExpr - GoalInfo, Constraints, FinalGoals, !Info,
+        !IO) :-
+    (
+        GoalExpr = conj(ConjType, Goals0),
     (
         ConjType = plain_conj,
-        MoreGoals = [],
-        propagate_conj(Goals0, Constraints0, Goals, !Info, !IO)
+            propagate_conj(Goals0, Constraints, Goals, !Info, !IO),
+            FinalGoals = [conj(ConjType, Goals) - GoalInfo]
     ;
         ConjType = parallel_conj,
         % We can't propagate constraints into parallel conjunctions because
         % parallel conjunctions must have determinism det. However, we can
         % propagate constraints *within* the goals of the conjunction.
-        flatten_constraints(Constraints0, MoreGoals),
-        propagate_in_independent_goals(Goals0, [], Goals, !Info, !IO)
-    ).
-
-propagate_conj_sub_goal_2(disj(Goals0) - Info, Constraints,
-        [disj(Goals) - Info], !Info, !IO) :-
-    propagate_in_independent_goals(Goals0, Constraints, Goals, !Info, !IO).
-
-propagate_conj_sub_goal_2(switch(Var, CanFail, Cases0) - Info,
-        Constraints, [switch(Var, CanFail, Cases) - Info], !Info, !IO) :-
-    propagate_cases(Var, Constraints, Cases0, Cases, !Info, !IO).
-
-propagate_conj_sub_goal_2(
-        if_then_else(Vars, Cond0, Then0, Else0) - Info,
-        Constraints,
-        [if_then_else(Vars, Cond, Then, Else) - Info], !Info, !IO) :-
+            flatten_constraints(Constraints, MoreGoals),
+            propagate_in_independent_goals(Goals0, [], Goals, !Info, !IO),
+            FinalGoals = [conj(ConjType, Goals) - GoalInfo | MoreGoals]
+        )
+    ;
+        GoalExpr = disj(Goals0),
+        propagate_in_independent_goals(Goals0, Constraints, Goals, !Info, !IO),
+        FinalGoals = [disj(Goals) - GoalInfo]
+    ;
+        GoalExpr = switch(Var, CanFail, Cases0),
+        propagate_cases(Var, Constraints, Cases0, Cases, !Info, !IO),
+        FinalGoals = [switch(Var, CanFail, Cases) - GoalInfo]
+    ;
+        GoalExpr = if_then_else(Vars, Cond0, Then0, Else0),
     InstMap0 = !.Info ^ instmap,
-
     % We can't safely propagate constraints into the condition of an
     % if-then-else, because that would change the answers generated
     % by the procedure.
@@ -163,44 +162,51 @@
     constraint_info_update_goal(Cond, !Info),
     propagate_goal(Then0, Constraints, Then, !Info, !IO),
     !:Info = !.Info ^ instmap := InstMap0,
-    propagate_goal(Else0, Constraints, Else, !Info, !IO).
-
-propagate_conj_sub_goal_2(scope(Reason, Goal0) - GoalInfo, Constraints,
-        [scope(Reason, Goal) - GoalInfo], !Info, !IO) :-
-    propagate_goal(Goal0, Constraints, Goal, !Info, !IO).
-
-propagate_conj_sub_goal_2(not(NegGoal0) - GoalInfo, Constraints0,
-        [not(NegGoal) - GoalInfo | Constraints], !Info, !IO) :-
+        propagate_goal(Else0, Constraints, Else, !Info, !IO),
+        FinalGoals = [if_then_else(Vars, Cond, Then, Else) - GoalInfo]
+    ;
+        GoalExpr = scope(Reason, SubGoal0),
+        (
+            Reason = exist_quant(_),
+            propagate_goal(SubGoal0, Constraints, SubGoal, !Info, !IO),
+            FinalGoals = [scope(Reason, SubGoal) - GoalInfo]
+        ;
+            Reason = from_ground_term(_),
+            propagate_goal(SubGoal0, Constraints, SubGoal, !Info, !IO),
+            FinalGoals = [scope(Reason, SubGoal) - GoalInfo]
+        ;
+            ( Reason = promise_solutions(_, _)
+            ; Reason = promise_purity(_, _)
+            ; Reason = commit(_)
+            ; Reason = barrier(_)
+            ),
+            % We can't safely propagate constraints into one of these scopes.
+            % However, we can propagate constraints inside the scope goal.
+            propagate_goal(SubGoal0, [], SubGoal, !Info, !IO),
+            flatten_constraints(Constraints, ConstraintGoals),
+            FinalGoals = [scope(Reason, SubGoal) - GoalInfo | ConstraintGoals]
+        )
+    ;
+        GoalExpr = not(NegGoal0),
     % We can't safely propagate constraints into a negation,
     % because that would change the answers computed by the procedure.
     propagate_goal(NegGoal0, [], NegGoal, !Info, !IO),
-    flatten_constraints(Constraints0, Constraints).
-
-propagate_conj_sub_goal_2(Goal, Constraints0,
-        [Goal | Constraints], !Info, !IO) :-
+        flatten_constraints(Constraints, ConstraintGoals),
+        FinalGoals = [not(NegGoal) - GoalInfo | ConstraintGoals]
+    ;
+        ( GoalExpr = call(_, _, _, _, _, _)
+        ; GoalExpr = generic_call(_, _, _, _)
+        ; GoalExpr = foreign_proc(_, _, _, _, _, _)
+        ; GoalExpr = unify(_, _, _, _, _)
+        ),
     % Propagate_conj will move the constraints to the left of the call
-    % if that is possible, so nothing needs to be done here.
-    Goal = call(_, _, _, _, _, _) - _,
-    flatten_constraints(Constraints0, Constraints).
-
-propagate_conj_sub_goal_2(Goal, Constraints0,
-        [Goal | Constraints], !Info, !IO) :-
-    Goal = generic_call(_, _, _, _) - _,
-    flatten_constraints(Constraints0, Constraints).
-
-propagate_conj_sub_goal_2(Goal, Constraints0,
-        [Goal | Constraints], !Info, !IO) :-
-    Goal = foreign_proc(_, _, _, _, _, _) - _,
-    flatten_constraints(Constraints0, Constraints).
-
-propagate_conj_sub_goal_2(Goal, Constraints0,
-        [Goal | Constraints], !Info, !IO) :-
-    Goal = unify(_, _, _, _, _) - _,
-    flatten_constraints(Constraints0, Constraints).
-
-propagate_conj_sub_goal_2(Goal, _, _, !Info, !IO) :-
-    Goal = shorthand(_) - _,
-    unexpected(this_file, "propagate_conj_sub_goal_2: shorthand").
+        % or unification if that is possible, so nothing needs to be done here.
+        flatten_constraints(Constraints, ConstraintGoals),
+        FinalGoals = [GoalExpr - GoalInfo | ConstraintGoals]
+    ;
+        GoalExpr = shorthand(_),
+        unexpected(this_file, "propagate_conj_sub_goal_2: shorthand")
+    ).
 
 %-----------------------------------------------------------------------------%
 
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing debian/patches
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
Index: tests/hard_coded/Mercury.options
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/Mercury.options,v
retrieving revision 1.16
diff -u -b -r1.16 Mercury.options
--- tests/hard_coded/Mercury.options	14 Feb 2006 04:37:13 -0000	1.16
+++ tests/hard_coded/Mercury.options	6 Apr 2006 08:41:31 -0000
@@ -12,6 +12,7 @@
 MCFLAGS-ho_order	=	--optimize-higher-order
 MCFLAGS-ho_order2	=	--optimize-higher-order
 MCFLAGS-no_fully_strict	=	--no-fully-strict
+MCFLAGS-one_member	=	-O5
 MCFLAGS-impure_foreign	=	--optimize-duplicate-calls
 MCFLAGS-intermod_c_code =	--intermodule-optimization
 MCFLAGS-intermod_c_code2 =	--intermodule-optimization
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------