[m-rev.] diff: handle nested conjunctions in mode analysis

Mark Brown mark at cs.mu.OZ.AU
Wed Aug 3 21:50:44 AEST 2005


This addresses a bug reported by Peter Hawkins recently.

Cheers,
Mark.

Estimated hours taken: 2
Branches: main, release

Don't assume that conjunctions will be flattened when doing mode
analysis.  Instead, flatten conjunctions as they are traversed.
The polymorphism transformation doesn't preserve the invariant that
conjunctions should be flattened, and this can cause mode errors to
be reported on code that is type and mode correct.  On the other
hand, handling nested conjunctions in the mode analyser is not
particularly expensive.

compiler/modes.m:
compiler/unique_modes.m:
	Traverse into nested conjunctions when mode checking conjunctions,
	and also when processing live vars.

	Rename a couple of predicates that had uninformative names.
	modecheck_conj_list_3 becomes modecheck_delayed_goals_try_det, and
	modecheck_conj_list_4 becomes modecheck_delayed_goals_eager, since
	they are both concerned with the strategies used to schedule goals
	that are delayed due to uninitialised solver variables.

tests/valid/Mmakefile:
tests/valid/flatten_conj_bug.m:
	A test case that doesn't compile without this change.

Index: compiler/modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.301
diff -u -r1.301 modes.m
--- compiler/modes.m	10 Jun 2005 06:17:20 -0000	1.301
+++ compiler/modes.m	3 Aug 2005 08:41:05 -0000
@@ -1962,31 +1962,64 @@
     % at the start of the list of live vars sets, which
     % makes them cheaper to remove.
     mode_info_add_goals_live_vars(Goals, !ModeInfo),
-    goal_get_nonlocals(Goal, NonLocals),
-    mode_info_add_live_vars(NonLocals, !ModeInfo).
+    (
+        % Recurse into conjunctions, in case there are any conjunctions
+        % that have not been flattened.
+        Goal = conj(ConjGoals) - _
+    ->
+        mode_info_add_goals_live_vars(ConjGoals, !ModeInfo)
+    ;
+        goal_get_nonlocals(Goal, NonLocals),
+        mode_info_add_live_vars(NonLocals, !ModeInfo)
+    ).
 
 mode_info_remove_goals_live_vars([], !ModeInfo).
 mode_info_remove_goals_live_vars([Goal | Goals], !ModeInfo) :-
-    goal_get_nonlocals(Goal, NonLocals),
-    mode_info_remove_live_vars(NonLocals, !ModeInfo),
+    (
+        % Recurse into conjunctions, in case there are any conjunctions
+        % that have not been flattened.
+        Goal = conj(ConjGoals) - _
+    ->
+        mode_info_remove_goals_live_vars(ConjGoals, !ModeInfo)
+    ;
+        goal_get_nonlocals(Goal, NonLocals),
+        mode_info_remove_live_vars(NonLocals, !ModeInfo)
+    ),
     mode_info_remove_goals_live_vars(Goals, !ModeInfo).
 
 :- type impurity_errors == list(mode_error_info).
 
+    % Flatten conjunctions as we go.  Call modecheck_conj_list_3 to do
+    % the actual scheduling.
+    %
 :- pred modecheck_conj_list_2(list(hlds_goal)::in, list(hlds_goal)::out,
     impurity_errors::in, impurity_errors::out,
     mode_info::in, mode_info::out, io::di, io::uo) is det.
 
-    % Schedule a conjunction.
-    % If it's empty, then there is nothing to do.
+modecheck_conj_list_2([], [], !ImpurityErrors, !ModeInfo, !IO).
+modecheck_conj_list_2([Goal0 | Goals0], Goals, !ImpurityErrors, !ModeInfo,
+        !IO) :-
+    (
+        Goal0 = conj(ConjGoals) - _
+    ->
+        list__append(ConjGoals, Goals0, Goals1),
+        modecheck_conj_list_2(Goals1, Goals, !ImpurityErrors, !ModeInfo, !IO)
+    ;
+        modecheck_conj_list_3(Goal0, Goals0, Goals, !ImpurityErrors,
+            !ModeInfo, !IO)
+    ).
+
+:- pred modecheck_conj_list_3(hlds_goal::in, list(hlds_goal)::in,
+    list(hlds_goal)::out, impurity_errors::in, impurity_errors::out,
+    mode_info::in, mode_info::out, io::di, io::uo) is det.
+
+    % Schedule a conjunction.  If it's empty, then there is nothing to do.
     % For non-empty conjunctions, we attempt to schedule the first
     % goal in the conjunction.  If successful, we wakeup a newly
     % pending goal (if any), and if not, we delay the goal.  Then we
     % continue attempting to schedule all the rest of the goals.
     %
-modecheck_conj_list_2([], [], !ImpurityErrors, !ModeInfo, !IO).
-modecheck_conj_list_2([Goal0 | Goals0], Goals, !ImpurityErrors, !ModeInfo,
-        !IO) :-
+modecheck_conj_list_3(Goal0, Goals0, Goals, !ImpurityErrors, !ModeInfo, !IO) :-
     Goal0 = _GoalExpr - GoalInfo0,
     ( goal_info_is_impure(GoalInfo0) ->
         Impure = yes,
@@ -2061,6 +2094,7 @@
         mode_info_remove_goals_live_vars(Goals1, !ModeInfo),
         Goals2  = []
     ;
+        % The remaining goals may still need to be flattened.
         modecheck_conj_list_2(Goals1, Goals2, !ImpurityErrors, !ModeInfo, !IO)
     ),
     (
@@ -2097,12 +2131,13 @@
         % initialisation calls, aiming for a deterministic
         % schedule.
         %
-    modecheck_conj_list_3(DelayedGoals0, DelayedGoals1, Goals0,
+    modecheck_delayed_goals_try_det(DelayedGoals0, DelayedGoals1, Goals0,
         !ImpurityErrors, !ModeInfo, !IO),
+
         % Try to handle any unscheduled goals by inserting solver
         % initialisation calls, aiming for *any* workable schedule.
         %
-    modecheck_conj_list_4(DelayedGoals1, DelayedGoals, Goals1,
+    modecheck_delayed_goals_eager(DelayedGoals1, DelayedGoals, Goals1,
         !ImpurityErrors, !ModeInfo, !IO),
     Goals = Goals0 ++ Goals1.
 
@@ -2134,11 +2169,12 @@
     % XXX At some point we should extend this analysis to handle
     % disjunction, if-then-else goals, and negation.
     %
-:- pred modecheck_conj_list_3(list(delayed_goal)::in, list(delayed_goal)::out,
-    list(hlds_goal)::out, impurity_errors::in, impurity_errors::out,
+:- pred modecheck_delayed_goals_try_det(list(delayed_goal)::in,
+    list(delayed_goal)::out, list(hlds_goal)::out,
+    impurity_errors::in, impurity_errors::out,
     mode_info::in, mode_info::out, io::di, io::uo) is det.
 
-modecheck_conj_list_3(DelayedGoals0, DelayedGoals, Goals,
+modecheck_delayed_goals_try_det(DelayedGoals0, DelayedGoals, Goals,
         !ImpurityErrors, !ModeInfo, !IO) :-
     (
             % There are no unscheduled goals, so we don't
@@ -2433,12 +2469,15 @@
     % initialisation calls are needed to turn some solver type vars
     % from inst free to inst any.  This pass tries to unblock the
     % remaining goals by conservatively inserting initialisation calls.
+    % It is "eager" in the sense that as soon as it encounters a sub-goal
+    % that may be unblocked this way it tries to do so.
     %
-:- pred modecheck_conj_list_4(list(delayed_goal)::in, list(delayed_goal)::out,
-    list(hlds_goal)::out, impurity_errors::in, impurity_errors::out,
+:- pred modecheck_delayed_goals_eager(list(delayed_goal)::in,
+    list(delayed_goal)::out, list(hlds_goal)::out,
+    impurity_errors::in, impurity_errors::out,
     mode_info::in, mode_info::out, io::di, io::uo) is det.
 
-modecheck_conj_list_4(DelayedGoals0, DelayedGoals, Goals,
+modecheck_delayed_goals_eager(DelayedGoals0, DelayedGoals, Goals,
         !ImpurityErrors, !ModeInfo, !IO) :-
     (
             % There are no unscheduled goals, so we don't
@@ -2461,8 +2500,8 @@
         mode_info_set_delay_info(DelayInfo1, !ModeInfo),
 
         mode_info_set_may_initialise_solver_vars(yes, !ModeInfo),
-        modecheck_conj_list_2(Goals0, Goals1,
-            !ImpurityErrors, !ModeInfo, !IO),
+        modecheck_conj_list_2(Goals0, Goals1, !ImpurityErrors,
+            !ModeInfo, !IO),
         mode_info_set_may_initialise_solver_vars(no, !ModeInfo),
 
         mode_info_get_delay_info(!.ModeInfo, DelayInfo2),
@@ -2477,7 +2516,7 @@
                 % We scheduled some goals.  Keep going
                 % until we flounder or succeed.
                 %
-            modecheck_conj_list_4(DelayedGoals1, DelayedGoals,
+            modecheck_delayed_goals_eager(DelayedGoals1, DelayedGoals,
                 Goals2, !ImpurityErrors, !ModeInfo, !IO),
             Goals = Goals1 ++ Goals2
         ;
Index: compiler/unique_modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unique_modes.m,v
retrieving revision 1.90
diff -u -r1.90 unique_modes.m
--- compiler/unique_modes.m	31 May 2005 06:55:32 -0000	1.90
+++ compiler/unique_modes.m	3 Aug 2005 08:42:16 -0000
@@ -697,11 +697,26 @@
 :- pred unique_modes__check_conj(list(hlds_goal)::in, list(hlds_goal)::out,
 	mode_info::in, mode_info::out, io::di, io::uo) is det.
 
-	% Just process each conjunct in turn.
-	% Note that we don't do any reordering of conjuncts here.
-
+	% Just process each conjunct in turn.  Note that we don't do any
+	% reordering of conjuncts here, although we do flatten conjunctions.
+	%
 unique_modes__check_conj([], [], !ModeInfo, !IO).
-unique_modes__check_conj([Goal0 | Goals0], [Goal | Goals], !ModeInfo, !IO) :-
+unique_modes__check_conj([Goal0 | Goals0], Goals, !ModeInfo, !IO) :-
+	(
+		Goal0 = conj(ConjGoals) - _
+	->
+		list__append(ConjGoals, Goals0, Goals1),
+		unique_modes__check_conj(Goals1, Goals, !ModeInfo, !IO)
+	;
+		unique_modes__check_conj_2(Goal0, Goals0, Goals, !ModeInfo,
+			!IO)
+	).
+
+:- pred unique_modes__check_conj_2(hlds_goal::in, list(hlds_goal)::in,
+	list(hlds_goal)::out, mode_info::in, mode_info::out, io::di, io::uo)
+	is det.
+
+unique_modes__check_conj_2(Goal0, Goals0, [Goal | Goals], !ModeInfo, !IO) :-
 	goal_get_nonlocals(Goal0, NonLocals),
 	mode_info_remove_live_vars(NonLocals, !ModeInfo),
 	unique_modes__check_goal(Goal0, Goal, !ModeInfo, !IO),
Index: tests/valid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/valid/Mmakefile,v
retrieving revision 1.154
diff -u -r1.154 Mmakefile
--- tests/valid/Mmakefile	23 May 2005 08:37:04 -0000	1.154
+++ tests/valid/Mmakefile	3 Aug 2005 02:33:31 -0000
@@ -21,6 +21,7 @@
 	abstract_typeclass \
 	complex_constraint \
 	constraint_proof_bug \
+	flatten_conj_bug \
 	func_method \
 	fundeps \
 	instance_superclass \
Index: tests/valid/flatten_conj_bug.m
===================================================================
RCS file: tests/valid/flatten_conj_bug.m
diff -N tests/valid/flatten_conj_bug.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/valid/flatten_conj_bug.m	3 Aug 2005 02:35:01 -0000
@@ -0,0 +1,33 @@
+:- module flatten_conj_bug.
+:- interface.
+:- import_module list.
+
+    % A type
+:- type cvar(T) ---> cvar(v :: T, x :: list(int)).
+:- inst cvar ---> cvar(ground, non_empty_list).
+
+    % A typeclass.
+:- typeclass cvar_type(T) where [].
+
+:- type cvar_wrapper ---> some [T] (
+    cvar_wrapper(cvar :: cvar(T)) => cvar_type(T)
+).
+
+:- some [T] func unwrap_cvar(cvar_wrapper::in) = (cvar(T)::out(cvar)) is det
+    => (cvar_type(T)).
+
+:- implementation.
+
+	% The transformed version of this function was not able to be
+	% mode checked.  The reason for this is that polymorphism was not
+	% flattening conjunctions, and the conjuncts were therefore not
+	% able to be scheduled in any order that would work.
+	%
+unwrap_cvar(cvar_wrapper(V)) = unsafe_any_to_cvar(V).
+
+:- func unsafe_any_to_cvar(cvar(T)::in) = (cvar(T)::out(cvar)) is det.
+
+:- pragma foreign_proc("C", unsafe_any_to_cvar(X::in) = (Y::out(cvar)),
+    [will_not_call_mercury, promise_pure], "Y = X;").
+
+
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------



More information about the reviews mailing list