[m-rev.] for review: fix from_ground_term bugs

Zoltan Somogyi zs at csse.unimelb.edu.au
Tue Sep 22 16:13:30 AEST 2009


For review by Peter Wang.

Zoltan.

Fix three bugs with from_ground_term scopes, including Mantis bugs 93 and 94.

compiler/superhomogenenous.m:
	Fix Mantis bug 94. The problem was an overzealous sanity check.

compiler/modes.m:
	Fix Mantis bug 93. When analysing a from_ground_term_construct scope,
	we set the inst of the var being built to ground, since the shared
	nature of static terms requires this. However, some code may require
	the term to be unique. We therefore prepare to do mode analysis twice.
	On the first pass, we consider terms from from_ground_term to be
	ground, as before, but we record the fact that we did so. If
	mode analysis of the procedure yields one or more errors, they could
	have been due to this decision. So we analyze the procedure a second
	time, but this time, after each from_ground_term_construct scope,
	we add a call to builtin.copy, which yields a unique term.

	Note that this may be overkill. Even if e.g. the procedure has three
	from_ground_term_construct scopes, only one of which need to be unique
	for mode analysis to succeed, we will call copy after all three.

compiler/mode_info.m:
	Provide the infrastructure for the fix in modes.m.

compiler/quantification.m:
	Fix the third bug, which is not in Mantis. The bug was that after my
	recent optimization of quantification, we never listed the local
	variables of from_ground_term_construct scopes in the outputs of the
	goal_vars_* family of predicates. However, there is one case where they
	are needed, and this is when we want to duplicate the goal, and need to
	rename *all* the variables in the copy.

	The fix is to add new versions of goal_vars_* and their auxiliary
	predicates that collect this information, and use them when expanding
	out bi_implications.

	This now also expects that bi_implications won't occur in the hLDS
	by the time that lambda expansion has been done. Since lambda expansion
	is done in the middle pass, and bi_implications are expanded out by the
	very first invocation of quantification, even *before* semantic
	analysis starts, this is a safe bet.

compiler/hlds_goal.m:
	Document where bi_implications are expanded out.

compiler/polymorphism.m:
	Minor style improment.

compiler/options.m:
	Set the default from_ground_term threshold to what it was before
	we discovered these problems.

tests/hard_coded/uo_regression1.{m,exp}:
tests/hard_coded/from_ground_term_bug.{m,exp}:
	Slightly modified versions of the Mantis test cases for bugs 93 and 94.

tests/hard_coded/type_qual.{m,exp}:
	This test case was the one that shows the third bug. Expand it
	to put a from_ground_term_construct scope in the LHS as well as RHS
	of a bi-implication.

tests/hard_coded/Mmakefile:
tests/hard_coded/Mercury.options:
	Enable the two new tests, and enable from_ground_term_construct scopes
	on all three tests.

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/libatomic_ops-1.2
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/doc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/tests
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing boehm_gc/windows-untested
cvs diff: Diffing boehm_gc/windows-untested/vc60
cvs diff: Diffing boehm_gc/windows-untested/vc70
cvs diff: Diffing boehm_gc/windows-untested/vc71
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_goal.m,v
retrieving revision 1.211
diff -u -b -r1.211 hlds_goal.m
--- compiler/hlds_goal.m	3 Sep 2009 23:57:24 -0000	1.211
+++ compiler/hlds_goal.m	22 Sep 2009 05:02:50 -0000
@@ -243,6 +243,8 @@
                 % the HLDS.  We cannot do that for bi-implications, because
                 % if expansion of bi-implications is done before implicit
                 % quantification, then the quantification would be wrong.
+                %
+                % bi_implications are expanded out by quantification.m.
 
                 hlds_goal,
                 hlds_goal
Index: compiler/mode_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mode_info.m,v
retrieving revision 1.98
diff -u -b -r1.98 mode_info.m
--- compiler/mode_info.m	23 Dec 2008 01:37:37 -0000	1.98
+++ compiler/mode_info.m	21 Sep 2009 11:04:04 -0000
@@ -119,9 +119,17 @@
     --->    in_promise_purity_scope
     ;       not_in_promise_purity_scope.
 
-:- type in_from_ground_term
-    --->    in_from_ground_term
-    ;       not_in_from_ground_term.
+:- type in_from_ground_term_scope
+    --->    in_from_ground_term_scope
+    ;       not_in_from_ground_term_scope.
+
+:- type had_from_ground_term_scope
+    --->    had_from_ground_term_scope
+    ;       did_not_have_from_ground_term_scope.
+
+:- type make_ground_terms_unique
+    --->    make_ground_terms_unique
+    ;       do_not_make_ground_terms_unique.
 
 :- type in_dupl_for_switch
     --->    in_dupl_for_switch
@@ -184,7 +192,11 @@
 :- pred mode_info_get_may_init_solver_vars(mode_info::in,
     may_init_solver_vars::out) is det.
 :- pred mode_info_get_in_from_ground_term(mode_info::in,
-    in_from_ground_term::out) is det.
+    in_from_ground_term_scope::out) is det.
+:- pred mode_info_get_had_from_ground_term(mode_info::in,
+    had_from_ground_term_scope::out) is det.
+:- pred mode_info_get_make_ground_terms_unique(mode_info::in,
+    make_ground_terms_unique::out) is det.
 :- pred mode_info_get_in_dupl_for_switch(mode_info::in,
     in_dupl_for_switch::out) is det.
 
@@ -246,7 +258,11 @@
     mode_info::in, mode_info::out) is det.
 :- pred mode_info_set_may_init_solver_vars(may_init_solver_vars::in,
     mode_info::in, mode_info::out) is det.
-:- pred mode_info_set_in_from_ground_term(in_from_ground_term::in,
+:- pred mode_info_set_in_from_ground_term(in_from_ground_term_scope::in,
+    mode_info::in, mode_info::out) is det.
+:- pred mode_info_set_had_from_ground_term(had_from_ground_term_scope::in,
+    mode_info::in, mode_info::out) is det.
+:- pred mode_info_set_make_ground_terms_unique(make_ground_terms_unique::in,
     mode_info::in, mode_info::out) is det.
 :- pred mode_info_set_in_dupl_for_switch(in_dupl_for_switch::in,
     mode_info::in, mode_info::out) is det.
@@ -409,20 +425,28 @@
                 % The mode warnings found.
                 msi_warnings                :: list(mode_warning_info),
 
-                % Set to `yes' if we need to requantify the procedure body
+                % Says whether we need to requantify the procedure body
                 % after mode analysis finishes.
                 msi_need_to_requantify      :: need_to_requantify,
 
-                % Set to `yes' if we are in a promise_<purity> scope.
+                % Says whether we are in a promise_<purity> scope.
                 % This information is needed to check that potentially impure
                 % uses of inst any non-locals in negated contexts are properly
                 % acknowledged by the programmer.
                 msi_in_promise_purity_scope :: in_promise_purity_scope,
 
-                % Set to `yes' if we are in a from_ground_term scope.
+                % Says whether we are in a from_ground_term scope.
                 % This information allows us to optimize some aspects of
                 % mode analysis.
-                msi_in_from_ground_term     :: in_from_ground_term,
+                msi_in_from_ground_term     :: in_from_ground_term_scope,
+
+                % Says whether we have ever come across in a from_ground_term
+                % scope.
+                msi_had_from_ground_term    :: had_from_ground_term_scope,
+
+                % Says whether we should copy the ground terms created by
+                % from_ground_term scopes, making them unique.
+                msi_make_ground_terms_unique :: make_ground_terms_unique,
 
                 % Set to `yes' if we are inside a goal with a
                 % duplicate_for_switch feature.
@@ -435,22 +459,22 @@
     %
 :- type mode_info
     --->    mode_info(
-                mi_module_info              :: module_info,
+/*  1 */        mi_module_info              :: module_info,
 
                 % The current instantiatedness of the variables.
-                mi_instmap                  :: instmap,
+/*  2 */        mi_instmap                  :: instmap,
 
                 % Info about delayed goals.
-                mi_delay_info               :: delay_info,
+/*  3 */        mi_delay_info               :: delay_info,
 
                 % The mode errors found.
-                mi_errors                   :: list(mode_error_info),
+/*  4 */        mi_errors                   :: list(mode_error_info),
 
                 % A description of where in the goal the error occurred.
-                mi_mode_context             :: mode_context,
+/*  5 */        mi_mode_context             :: mode_context,
 
                 % The line number of the subgoal we are currently checking.
-                mi_context                  :: prog_context,
+/*  6 */        mi_context                  :: prog_context,
 
                 % The nondet-live variables, i.e. those variables which may be
                 % referenced again after deep backtracking TO THE CURRENT
@@ -461,9 +485,9 @@
                 % to a point EARLIER THAN the current execution point, since
                 % those variables will *already* have been marked as
                 % mostly_unique rather than unique.)
-                mi_nondet_live_vars         :: bag(prog_var),
+/*  7 */        mi_nondet_live_vars         :: bag(prog_var),
 
-                mi_sub_info                 :: mode_sub_info
+/*  8 */        mi_sub_info                 :: mode_sub_info
             ).
 
 %-----------------------------------------------------------------------------%
@@ -505,14 +529,17 @@
     MayInitSolverVars = may_init_solver_vars,
     NeedToRequantify = do_not_need_to_requantify,
     InPromisePurityScope = not_in_promise_purity_scope,
-    InFromGroundTerm = not_in_from_ground_term,
+    InFromGroundTerm = not_in_from_ground_term_scope,
+    HadFromGroundTerm = did_not_have_from_ground_term_scope,
+    MakeGroundTermsUnique = do_not_make_ground_terms_unique,
     InDuplForSwitch = not_in_dupl_for_switch,
 
     ModeSubInfo = mode_sub_info(PredId, ProcId, VarSet, VarTypes, Debug,
         LockedVars, LiveVarsBag, InstVarSet, ParallelVars, HowToCheck,
         MayChangeProc, MayInitSolverVars, LastCheckpointInstMap, Changed,
         CheckingExtraGoals, InstMap0, WarningList, NeedToRequantify,
-        InPromisePurityScope, InFromGroundTerm, InDuplForSwitch),
+        InPromisePurityScope, InFromGroundTerm, HadFromGroundTerm,
+        MakeGroundTermsUnique, InDuplForSwitch),
 
     mode_context_init(ModeContext),
     delay_info_init(DelayInfo),
@@ -558,6 +585,10 @@
     MI ^ mi_sub_info ^ msi_checking_extra_goals).
 mode_info_get_in_from_ground_term(MI,
     MI ^ mi_sub_info ^ msi_in_from_ground_term).
+mode_info_get_had_from_ground_term(MI,
+    MI ^ mi_sub_info ^ msi_had_from_ground_term).
+mode_info_get_make_ground_terms_unique(MI,
+    MI ^ mi_sub_info ^ msi_make_ground_terms_unique).
 mode_info_get_in_dupl_for_switch(MI,
     MI ^ mi_sub_info ^ msi_in_dupl_for_switch).
 
@@ -596,8 +627,12 @@
     MI ^ mi_sub_info ^ msi_may_change_called_proc := MayChange).
 mode_info_set_may_init_solver_vars(MayInit, MI,
     MI ^ mi_sub_info ^ msi_may_init_solver_vars := MayInit).
-mode_info_set_in_from_ground_term(FGI, MI,
-    MI ^ mi_sub_info ^ msi_in_from_ground_term := FGI).
+mode_info_set_in_from_ground_term(IFGI, MI,
+    MI ^ mi_sub_info ^ msi_in_from_ground_term := IFGI).
+mode_info_set_had_from_ground_term(HFGI, MI,
+    MI ^ mi_sub_info ^ msi_had_from_ground_term := HFGI).
+mode_info_set_make_ground_terms_unique(MGTU, MI,
+    MI ^ mi_sub_info ^ msi_make_ground_terms_unique := MGTU).
 mode_info_set_in_dupl_for_switch(INFS, MI,
     MI ^ mi_sub_info ^ msi_in_dupl_for_switch := INFS).
 
Index: compiler/modecheck_unify.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modecheck_unify.m,v
retrieving revision 1.131
diff -u -b -r1.131 modecheck_unify.m
--- compiler/modecheck_unify.m	16 Sep 2009 02:32:53 -0000	1.131
+++ compiler/modecheck_unify.m	21 Sep 2009 11:06:42 -0000
@@ -725,7 +725,7 @@
         UnifyArgInsts = list.map(func(I) = yes(I), InstOfXArgs),
         mode_info_get_in_from_ground_term(!.ModeInfo, InFromGroundTerm),
         (
-            InFromGroundTerm = in_from_ground_term
+            InFromGroundTerm = in_from_ground_term_scope
             % In the goals that result from the transformation of a unification
             % of a variable with a ground term, the variables on the right hand
             % sides of the construct unifications are all local to the scope
@@ -738,7 +738,7 @@
             % are N intermediate variables, the complexity of updating their
             % insts would be quadratic.
         ;
-            InFromGroundTerm = not_in_from_ground_term,
+            InFromGroundTerm = not_in_from_ground_term_scope,
             bind_args(Inst, ArgVars, UnifyArgInsts, !ModeInfo)
         )
     ;
Index: compiler/modes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.386
diff -u -b -r1.386 modes.m
--- compiler/modes.m	16 Sep 2009 02:32:53 -0000	1.386
+++ compiler/modes.m	22 Sep 2009 05:59:05 -0000
@@ -893,6 +893,117 @@
         ),
         mode_list_get_final_insts(!.ModuleInfo, ArgModes0, ArgFinalInsts0),
 
+        modecheck_proc_body(!.ModuleInfo, WhatToCheck, InferModes,
+            Markers, Body0, Body, HeadVars, InstMap0,
+            ArgFinalInsts0, ArgFinalInsts, !ModeInfo),
+
+        mode_info_get_errors(!.ModeInfo, ModeErrors),
+        (
+            InferModes = yes,
+            % For inferred predicates, we don't report the error(s) here;
+            % instead we just save them in the proc_info, thus marking that
+            % procedure as invalid.
+            !ProcInfo ^ mode_errors := ModeErrors,
+            ErrorAndWarningSpecs = []
+        ;
+            InferModes = no,
+            AllErrorSpecs = list.map(mode_error_info_to_spec(!.ModeInfo),
+                ModeErrors),
+
+            % We only return the first error, because there could be a
+            % large number of mode errors and usually only one is needed to
+            % diagnose the problem.
+
+            (
+                AllErrorSpecs = [ErrorSpec | _],
+                ErrorSpecs = [ErrorSpec]
+            ;
+                AllErrorSpecs = [],
+                ErrorSpecs = []
+            ),
+            mode_info_get_warnings(!.ModeInfo, ModeWarnings),
+            WarningSpecs = list.map(mode_warning_info_to_spec(!.ModeInfo),
+                ModeWarnings),
+            ErrorAndWarningSpecs = ErrorSpecs ++ WarningSpecs
+        ),
+
+        % Save away the results.
+        inst_lists_to_mode_list(ArgInitialInsts, ArgFinalInsts, ArgModes),
+        mode_info_get_changed_flag(!.ModeInfo, !:Changed),
+        mode_info_get_module_info(!.ModeInfo, !:ModuleInfo),
+        mode_info_get_varset(!.ModeInfo, VarSet),
+        % VarTypes may differ from VarTypes0, since mode checking can
+        % add new variables (e.g. when handling calls in implied modes).
+        mode_info_get_var_types(!.ModeInfo, VarTypes),
+        mode_info_get_need_to_requantify(!.ModeInfo, NeedToRequantify),
+        proc_info_set_goal(Body, !ProcInfo),
+        proc_info_set_varset(VarSet, !ProcInfo),
+        proc_info_set_vartypes(VarTypes, !ProcInfo),
+        proc_info_set_argmodes(ArgModes, !ProcInfo),
+        (
+            NeedToRequantify = do_not_need_to_requantify
+        ;
+            NeedToRequantify = need_to_requantify,
+            requantify_proc_general(ordinary_nonlocals_maybe_lambda, !ProcInfo)
+        )
+    ).
+
+:- pred modecheck_proc_body(module_info::in, how_to_check_goal::in,
+    bool::in, pred_markers::in, hlds_goal::in, hlds_goal::out,
+    list(prog_var)::in, instmap::in, list(mer_inst)::in, list(mer_inst)::out,
+    mode_info::in, mode_info::out) is det.
+
+modecheck_proc_body(ModuleInfo, WhatToCheck, InferModes, Markers,
+        Body0, Body, HeadVars, InstMap0, ArgFinalInsts0, ArgFinalInsts,
+        ModeInfo0, ModeInfo) :-
+    do_modecheck_proc_body(ModuleInfo, WhatToCheck, InferModes, Markers,
+        Body0, Body1, HeadVars, InstMap0, ArgFinalInsts0, ArgFinalInsts1,
+        ModeInfo0, ModeInfo1),
+    mode_info_get_errors(ModeInfo1, ModeErrors1),
+    (
+        ModeErrors1 = [],
+        Body = Body1,
+        ArgFinalInsts = ArgFinalInsts1,
+        ModeInfo = ModeInfo1
+    ;
+        ModeErrors1 = [_ | _],
+        mode_info_get_had_from_ground_term(ModeInfo1, HadFromGroundTerm),
+        (
+            HadFromGroundTerm = had_from_ground_term_scope,
+            % The error could have been due a ground term that we marked down
+            % as ground instead of unique. We therefore try again from the
+            % beginning, but this time, we tell the code that handles
+            % from_ground_term scopes to create unique terms.
+            %
+            % Note that this may be overkill. Even if e.g. the procedure has
+            % three from_ground_term_construct scopes, only one of which needs
+            % to be unique for mode analysis to succeed, we will call copy
+            % after all three. Fixing this would require a significantly more
+            % complicated approach.
+
+            mode_info_set_make_ground_terms_unique(make_ground_terms_unique,
+                ModeInfo0, ModeInfo2),
+            do_modecheck_proc_body(ModuleInfo, WhatToCheck, InferModes,
+                Markers, Body0, Body, HeadVars, InstMap0,
+                ArgFinalInsts0, ArgFinalInsts, ModeInfo2, ModeInfo)
+        ;
+            HadFromGroundTerm = did_not_have_from_ground_term_scope,
+            % The error could not have been due a ground term, so the results
+            % of the first analysis must stand.
+            Body = Body1,
+            ArgFinalInsts = ArgFinalInsts1,
+            ModeInfo = ModeInfo1
+        )
+    ).
+
+:- pred do_modecheck_proc_body(module_info::in, how_to_check_goal::in,
+    bool::in, pred_markers::in, hlds_goal::in, hlds_goal::out,
+    list(prog_var)::in, instmap::in, list(mer_inst)::in, list(mer_inst)::out,
+    mode_info::in, mode_info::out) is det.
+
+do_modecheck_proc_body(ModuleInfo, WhatToCheck, InferModes, Markers,
+        Body0, Body, HeadVars, InstMap0, ArgFinalInsts0, ArgFinalInsts,
+        !ModeInfo) :-
         (
             InferModes = no,
             check_marker(Markers, marker_mode_check_clauses),
@@ -908,8 +1019,7 @@
             ),
             BodyNonLocals = goal_info_get_nonlocals(BodyGoalInfo0),
             mode_info_get_var_types(!.ModeInfo, VarTypes0),
-            SolverNonLocals = list.filter(
-                is_solver_var(VarTypes0, !.ModuleInfo),
+        SolverNonLocals = list.filter(is_solver_var(VarTypes0, ModuleInfo),
                 set.to_sorted_list(BodyNonLocals)),
             SolverNonLocals = []
         ->
@@ -928,8 +1038,7 @@
                     ClausesForm0 = clause_disj(Disjuncts1),
                     Disjuncts2 = flatten_disjs(Disjuncts1),
                     list.map_foldl(
-                        modecheck_clause_disj(HeadVars, InstMap0,
-                            ArgFinalInsts0),
+                    modecheck_clause_disj(HeadVars, InstMap0, ArgFinalInsts0),
                         Disjuncts2, Disjuncts, !ModeInfo),
                     NewGoalExpr = disj(Disjuncts)
                 ;
@@ -962,8 +1071,7 @@
                     ),
                     list.map_foldl(
                         unique_modecheck_clause_disj(HeadVars, InstMap0,
-                            ArgFinalInsts0, Detism, NonLocals,
-                            NondetLiveVars0),
+                        ArgFinalInsts0, Detism, NonLocals, NondetLiveVars0),
                         Disjuncts2, Disjuncts, !ModeInfo),
                     NewGoalExpr = disj(Disjuncts)
                 ;
@@ -982,8 +1090,7 @@
             FinalInstMap = instmap_from_assoc_list(HeadVarFinalInsts),
             compute_instmap_delta(InstMap0, FinalInstMap, BodyNonLocals,
                 DeltaInstMap),
-            goal_info_set_instmap_delta(DeltaInstMap,
-                BodyGoalInfo0, BodyGoalInfo),
+        goal_info_set_instmap_delta(DeltaInstMap, BodyGoalInfo0, BodyGoalInfo),
             Body = hlds_goal(NewGoalExpr, BodyGoalInfo),
             ArgFinalInsts = ArgFinalInsts0
         ;
@@ -996,60 +1103,9 @@
                 unique_modes_check_goal(Body0, Body1, !ModeInfo)
             ),
 
-            % Check that final insts match those specified in the
-            % mode declaration.
-            modecheck_final_insts(HeadVars, InferModes, ArgFinalInsts0,
-                ArgFinalInsts, Body1, Body, !ModeInfo)
-        ),
-
-        mode_info_get_errors(!.ModeInfo, ModeErrors),
-        (
-            InferModes = yes,
-            % For inferred predicates, we don't report the error(s) here;
-            % instead we just save them in the proc_info, thus marking that
-            % procedure as invalid.
-            !ProcInfo ^ mode_errors := ModeErrors,
-            ErrorAndWarningSpecs = []
-        ;
-            InferModes = no,
-            AllErrorSpecs = list.map(mode_error_info_to_spec(!.ModeInfo),
-                ModeErrors),
-
-            % We only return the first error, because there could be a
-            % large number of mode errors and usually only one is needed to
-            % diagnose the problem.
-
-            (
-                AllErrorSpecs = [ErrorSpec | _],
-                ErrorSpecs = [ErrorSpec]
-            ;
-                AllErrorSpecs = [],
-                ErrorSpecs = []
-            ),
-            mode_info_get_warnings(!.ModeInfo, ModeWarnings),
-            WarningSpecs = list.map(mode_warning_info_to_spec(!.ModeInfo),
-                ModeWarnings),
-            ErrorAndWarningSpecs = ErrorSpecs ++ WarningSpecs
-        ),
-        % Save away the results.
-        inst_lists_to_mode_list(ArgInitialInsts, ArgFinalInsts, ArgModes),
-        mode_info_get_changed_flag(!.ModeInfo, !:Changed),
-        mode_info_get_module_info(!.ModeInfo, !:ModuleInfo),
-        mode_info_get_varset(!.ModeInfo, VarSet),
-        % VarTypes may differ from VarTypes0, since mode checking can
-        % add new variables (e.g. when handling calls in implied modes).
-        mode_info_get_var_types(!.ModeInfo, VarTypes),
-        mode_info_get_need_to_requantify(!.ModeInfo, NeedToRequantify),
-        proc_info_set_goal(Body, !ProcInfo),
-        proc_info_set_varset(VarSet, !ProcInfo),
-        proc_info_set_vartypes(VarTypes, !ProcInfo),
-        proc_info_set_argmodes(ArgModes, !ProcInfo),
-        (
-            NeedToRequantify = do_not_need_to_requantify
-        ;
-            NeedToRequantify = need_to_requantify,
-            requantify_proc_general(ordinary_nonlocals_maybe_lambda, !ProcInfo)
-        )
+        % Check that final insts match those specified in the mode declaration.
+        modecheck_final_insts(HeadVars, InferModes,
+            ArgFinalInsts0, ArgFinalInsts, Body1, Body, !ModeInfo)
     ).
 
 %-----------------------------------------------------------------------------%
@@ -1438,10 +1494,9 @@
                         Reason = wrongly_instantiated
                     ),
                     set.init(WaitingVars),
-                    mode_info_error(WaitingVars,
-                        mode_error_final_inst(ArgNum, Var, VarInst, Inst,
-                            Reason),
-                        !ModeInfo)
+                    ModeError = mode_error_final_inst(ArgNum, Var, VarInst,
+                        Inst, Reason),
+                    mode_info_error(WaitingVars, ModeError, !ModeInfo)
                 )
             )
         ),
@@ -1655,7 +1710,7 @@
         % time on those variables and add lots of big insts to the merge_inst
         % table. That in turn will cause the later equiv_type_hlds pass
         % to take a long time processing the merge_inst table. All this
-        % expensse is for nothing, since the chances that the following code
+        % expense is for nothing, since the chances that the following code
         % wants to know the precise set of possible bindings of variables
         % constructed in what are effectively fact tables is astronomically
         % small.
@@ -1823,10 +1878,191 @@
         GoalExpr = scope(Reason, SubGoal),
         mode_checkpoint(exit, "scope", !ModeInfo)
     ;
-        Reason = from_ground_term(TermVar, _OldKind),
+        Reason = from_ground_term(TermVar, _),
+        mode_checkpoint(enter, "scope", !ModeInfo),
+        modecheck_goal_from_ground_term_scope(TermVar, SubGoal0, GoalInfo0,
+            Kind1, SubGoal1, !ModeInfo),
+        mode_checkpoint(exit, "scope", !ModeInfo),
+        mode_info_set_had_from_ground_term(had_from_ground_term_scope,
+            !ModeInfo),
+
+        mode_info_get_make_ground_terms_unique(!.ModeInfo,
+            MakeGroundTermsUnique),
+        (
+            MakeGroundTermsUnique = do_not_make_ground_terms_unique,
+            UpdatedReason1 = from_ground_term(TermVar, Kind1),
+            GoalExpr = scope(UpdatedReason1, SubGoal1)
+        ;
+            MakeGroundTermsUnique = make_ground_terms_unique,
+            (
+                Kind1 = from_ground_term_construct,
+                modecheck_goal_make_ground_term_unique(TermVar,
+                    SubGoal1, GoalInfo0, GoalExpr, !ModeInfo)
+            ;
+                ( Kind1 = from_ground_term_deconstruct
+                ; Kind1 = from_ground_term_other
+                ),
+                % Do not wrap the subgoal up in a scope, since these scopes
+                % do not get useful any special treatment.
+                SubGoal1 = hlds_goal(GoalExpr, _)
+            )
+        )
+    ;
+        Reason = promise_purity(_Purity),
+        mode_info_get_in_promise_purity_scope(!.ModeInfo, InPPScope),
+        mode_info_set_in_promise_purity_scope(in_promise_purity_scope,
+            !ModeInfo),
+        mode_checkpoint(enter, "scope", !ModeInfo),
+        modecheck_goal(SubGoal0, SubGoal, !ModeInfo),
+        GoalExpr = scope(Reason, SubGoal),
+        mode_checkpoint(exit, "scope", !ModeInfo),
+        mode_info_set_in_promise_purity_scope(InPPScope, !ModeInfo)
+    ).
+
+    % This predicate transforms
+    %
+    %   scope(TermVar,
+    %       conj(plain_conj,
+    %           X1 = ...
+    %           X2 = ...
+    %           ...
+    %           TermVar = ...
+    %       )
+    %   )
+    %
+    % into
+    %
+    %   conj(plain_conj,
+    %       scope(TermVar,
+    %           conj(plain_conj,
+    %               X1 = ...
+    %               X2 = ...
+    %               ...
+    %               CloneVar = ...
+    %           )
+    %       ),
+    %       builtin.copy(CloneVar, TermVar)
+    %   )
+    %
+    % We could transform it instead into a plain conjunction that directly
+    % builds a unique term, but that could have a significant detrimental
+    % effect on compile time.
+    %
+    % The performance of the generated code is unlikely to be of too much
+    % importance, since we expect programs will rarely need a unique copy
+    % of a ground term.
+    %
+:- pred modecheck_goal_make_ground_term_unique(prog_var::in,
+    hlds_goal::in, hlds_goal_info::in, hlds_goal_expr::out,
+    mode_info::in, mode_info::out) is det.
+
+modecheck_goal_make_ground_term_unique(TermVar, SubGoal0, GoalInfo0, GoalExpr,
+        !ModeInfo) :-
+    mode_info_get_var_types(!.ModeInfo, VarTypes0),
+    mode_info_get_varset(!.ModeInfo, VarSet0),
+    varset.new_var(VarSet0, CloneVar, VarSet),
+    map.lookup(VarTypes0, TermVar, TermVarType),
+    map.det_insert(VarTypes0, CloneVar, TermVarType, VarTypes),
+    mode_info_set_varset(VarSet, !ModeInfo),
+    mode_info_set_var_types(VarTypes, !ModeInfo),
+    map.det_insert(map.init, TermVar, CloneVar, Rename),
+    % By construction, TermVar can appear only in (a) SubGoal0's goal_info,
+    % and (b) in the last conjunct in SubGoal0's goal_expr; it cannot appear
+    % in any of the other conjuncts. We could make this code more efficient
+    % by exploiting this fact, but there is not yet any evidence of any need
+    % for this.
+    rename_some_vars_in_goal(Rename, SubGoal0, SubGoal),
+    rename_vars_in_goal_info(need_not_rename, Rename, GoalInfo0,
+        ScopeGoalInfo1),
+
+    % We must put the instmaps into the goal_infos of all the subgoals of the
+    % final GoalExpr we return, since modecheck_goal will not get a chance to
+    % do so.
+    mode_info_get_instmap(!.ModeInfo, InstMap0),
+    instmap_lookup_var(InstMap0, TermVar, TermVarOldInst),
+    ScopeInstMapDelta =
+        instmap_delta_from_assoc_list([CloneVar - TermVarOldInst]),
+    goal_info_set_instmap_delta(ScopeInstMapDelta,
+        ScopeGoalInfo1, ScopeGoalInfo),
+
+    Reason = from_ground_term(CloneVar, from_ground_term_construct),
+    ScopeGoalExpr = scope(Reason, SubGoal),
+    ScopeGoal = hlds_goal(ScopeGoalExpr, ScopeGoalInfo),
+
+    % We could get a more accurate new inst for TermVar by replacing
+    % all the "shared" functors in TermVarOldInst with "unique".
+    % However, this should be good enough. XXX wangp, is this right?
+    TermVarUniqueInst = ground(unique, none),
+
+    instmap_set_var(CloneVar, TermVarOldInst, InstMap0, InstMap1),
+    mode_info_set_instmap(InstMap1, !ModeInfo),
+
+    Context = goal_info_get_context(GoalInfo0),
+    modecheck_make_type_info_var_for_type(TermVarType, Context, TypeInfoVar,
+        TypeInfoGoals, !ModeInfo),
+
+    InstMapDelta =
+        instmap_delta_from_assoc_list([TermVar - TermVarUniqueInst]),
+    mode_info_get_module_info(!.ModeInfo, ModuleInfo),
+    generate_simple_call(mercury_public_builtin_module, "copy", pf_predicate,
+        mode_no(1), detism_det, purity_pure, [TypeInfoVar, CloneVar, TermVar],
+        [], InstMapDelta, ModuleInfo, Context, CopyGoal),
+    mode_info_get_instmap(!.ModeInfo, InstMap2),
+    instmap_set_var(TermVar, TermVarUniqueInst, InstMap2, InstMap),
+    mode_info_set_instmap(InstMap, !ModeInfo),
+
+    GoalExpr = conj(plain_conj, [ScopeGoal | TypeInfoGoals] ++ [CopyGoal]).
+
+:- pred modecheck_make_type_info_var_for_type(mer_type::in, prog_context::in,
+    prog_var::out, list(hlds_goal)::out, mode_info::in, mode_info::out) is det.
+
+modecheck_make_type_info_var_for_type(Type, Context, TypeInfoVar,
+        TypeInfoGoals, !ModeInfo) :-
+    mode_info_get_module_info(!.ModeInfo, ModuleInfo0),
+
+    % Get the relevant information for the current procedure.
+    mode_info_get_pred_id(!.ModeInfo, PredId),
+    mode_info_get_proc_id(!.ModeInfo, ProcId),
+    module_info_pred_proc_info(ModuleInfo0, PredId, ProcId, PredInfo0,
+        ProcInfo0),
+
+    % Create a poly_info for the current procedure. We have to set the varset
+    % and vartypes from the mode_info, not the proc_info, because new vars may
+    % have been introduced during mode analysis, e.g. when adding
+    % unifications to handle implied modes.
+    mode_info_get_var_types(!.ModeInfo, VarTypes0),
+    mode_info_get_varset(!.ModeInfo, VarSet0),
+    proc_info_set_varset(VarSet0, ProcInfo0, ProcInfo1),
+    proc_info_set_vartypes(VarTypes0, ProcInfo1, ProcInfo2),
+    polymorphism.create_poly_info(ModuleInfo0, PredInfo0, ProcInfo2,
+        PolyInfo0),
+
+    polymorphism_make_type_info_var(Type, Context, TypeInfoVar, TypeInfoGoals,
+        PolyInfo0, PolyInfo),
+
+    % Update the information in the predicate table.
+    polymorphism.poly_info_extract(PolyInfo, PredInfo0, PredInfo,
+        ProcInfo2, ProcInfo, ModuleInfo1),
+    module_info_set_pred_proc_info(PredId, ProcId, PredInfo, ProcInfo,
+        ModuleInfo1, ModuleInfo),
+
+    % Update the information in the mode_info.
+    proc_info_get_varset(ProcInfo, VarSet),
+    proc_info_get_vartypes(ProcInfo, VarTypes),
+    mode_info_set_varset(VarSet, !ModeInfo),
+    mode_info_set_var_types(VarTypes, !ModeInfo),
+    mode_info_set_module_info(ModuleInfo, !ModeInfo).
+
+:- pred modecheck_goal_from_ground_term_scope(prog_var::in,
+    hlds_goal::in, hlds_goal_info::in, from_ground_term_kind::out,
+    hlds_goal::out, mode_info::in, mode_info::out) is det.
+
+modecheck_goal_from_ground_term_scope(TermVar, SubGoal0, GoalInfo0,
+        Kind, SubGoal, !ModeInfo) :-
         % The original goal does no quantification, so deleting the `scope'
         % would be OK. However, deleting it during mode analysis would mean
-        % we don't have it during unique mode analysis.
+    % we don't have it during unique mode analysis and other later compiler
+    % passes.
         mode_info_get_instmap(!.ModeInfo, InstMap0),
         instmap_lookup_var(InstMap0, TermVar, TermVarInst),
         mode_info_get_varset(!.ModeInfo, VarSet),
@@ -1837,9 +2073,7 @@
             SubGoal0 = hlds_goal(_, SubGoalInfo0),
             modecheck_ground_term_construct(TermVar, RevConj0,
                 SubGoalInfo0, VarSet, SubGoal, !ModeInfo),
-            Kind = from_ground_term_construct,
-            UpdatedReason = from_ground_term(TermVar, Kind),
-            GoalExpr = scope(UpdatedReason, SubGoal)
+        Kind = from_ground_term_construct
         ;
             (
                 MaybeGroundTermMode = yes(deconstruct_ground_term(_)),
@@ -1874,20 +2108,7 @@
             ),
             mode_checkpoint(enter, "scope", !ModeInfo),
             modecheck_goal(SubGoal2, SubGoal, !ModeInfo),
-            UpdatedReason = from_ground_term(TermVar, Kind),
-            GoalExpr = scope(UpdatedReason, SubGoal),
             mode_checkpoint(exit, "scope", !ModeInfo)
-        )
-    ;
-        Reason = promise_purity(_Purity),
-        mode_info_get_in_promise_purity_scope(!.ModeInfo, InPPScope),
-        mode_info_set_in_promise_purity_scope(in_promise_purity_scope,
-            !ModeInfo),
-        mode_checkpoint(enter, "scope", !ModeInfo),
-        modecheck_goal(SubGoal0, SubGoal, !ModeInfo),
-        GoalExpr = scope(Reason, SubGoal),
-        mode_checkpoint(exit, "scope", !ModeInfo),
-        mode_info_set_in_promise_purity_scope(InPPScope, !ModeInfo)
     ).
 
 :- type ground_term_mode
@@ -2326,9 +2547,9 @@
         mode_info_get_module_info(!.ModeInfo, ModuleInfo),
         inst_contains_any(ModuleInfo, Inst)
     ->
-        mode_info_error(make_singleton_set(NonLocal),
-            purity_error_should_be_in_promise_purity_scope(NegCtxtDesc,
-            NonLocal), !ModeInfo)
+        ModeError = purity_error_should_be_in_promise_purity_scope(NegCtxtDesc,
+            NonLocal),
+        mode_info_error(make_singleton_set(NonLocal), ModeError, !ModeInfo)
     ;
         check_no_inst_any_vars(NegCtxtDesc, NonLocals, InstMap0, InstMap,
             !ModeInfo)
@@ -2649,8 +2870,8 @@
         ;
             MoreDelayedGoals = [_ | _],
             get_all_waiting_vars(DelayedGoals, Vars),
-            mode_info_error(Vars,
-                mode_error_conj(DelayedGoals, conj_floundered), !ModeInfo)
+            ModeError = mode_error_conj(DelayedGoals, conj_floundered),
+            mode_info_error(Vars, ModeError, !ModeInfo)
         )
     ),
     % Restore the value of the may_initialise_solver_vars flag.
@@ -3668,7 +3889,8 @@
         VarIsLive = is_live
     ->
         set.singleton_set(WaitingVars, VarId),
-        mode_info_error(WaitingVars, mode_error_var_is_live(VarId), !ModeInfo)
+        ModeError = mode_error_var_is_live(VarId),
+        mode_info_error(WaitingVars, ModeError, !ModeInfo)
     ;
         true
     ).
@@ -3684,7 +3906,8 @@
         true
     ;
         set.singleton_set(WaitingVars, VarId),
-        mode_info_error(WaitingVars, mode_error_var_is_live(VarId), !ModeInfo)
+        ModeError = mode_error_var_is_live(VarId),
+        mode_info_error(WaitingVars, ModeError, !ModeInfo)
     ).
 
 %-----------------------------------------------------------------------------%
@@ -3760,8 +3983,8 @@
         mode_info_set_module_info(ModuleInfo, !ModeInfo)
     ;
         set.singleton_set(WaitingVars, Var),
-        mode_info_error(WaitingVars,
-            mode_error_var_has_inst(Var, VarInst, Inst), !ModeInfo)
+        ModeError = mode_error_var_has_inst(Var, VarInst, Inst),
+        mode_info_error(WaitingVars, ModeError, !ModeInfo)
     ).
 
 :- pred modecheck_var_has_inst_no_exact_match(prog_var::in, mer_inst::in,
@@ -3781,8 +4004,8 @@
         mode_info_set_module_info(ModuleInfo, !ModeInfo)
     ;
         set.singleton_set(WaitingVars, Var),
-        mode_info_error(WaitingVars,
-            mode_error_var_has_inst(Var, VarInst, Inst), !ModeInfo)
+        ModeError = mode_error_var_has_inst(Var, VarInst, Inst),
+        mode_info_error(WaitingVars, ModeError, !ModeInfo)
     ).
 
 modecheck_introduced_type_info_var_has_inst_no_exact_match(Var, Type, Inst,
@@ -3797,8 +4020,8 @@
         mode_info_set_module_info(ModuleInfo, !ModeInfo)
     ;
         set.singleton_set(WaitingVars, Var),
-        mode_info_error(WaitingVars,
-            mode_error_var_has_inst(Var, VarInst, Inst), !ModeInfo)
+        ModeError = mode_error_var_has_inst(Var, VarInst, Inst),
+        mode_info_error(WaitingVars, ModeError, !ModeInfo)
     ).
 
 %-----------------------------------------------------------------------------%
@@ -3919,8 +4142,8 @@
             )
         ->
             set.singleton_set(WaitingVars, Var0),
-            mode_info_error(WaitingVars,
-                mode_error_bind_var(Reason0, Var0, Inst0, Inst), !ModeInfo)
+            ModeError = mode_error_bind_var(Reason0, Var0, Inst0, Inst),
+            mode_info_error(WaitingVars, ModeError, !ModeInfo)
         ;
             instmap_set_var(Var0, Inst, InstMap0, InstMap),
             mode_info_set_instmap(InstMap, !ModeInfo),
@@ -4010,9 +4233,8 @@
             % If the type is a type variable, or isn't a solver type,
             % then give up.
             set.singleton_set(WaitingVars, Var0),
-            mode_info_error(WaitingVars,
-                mode_error_implied_mode(Var0, VarInst0, InitialInst),
-                !ModeInfo)
+            ModeError = mode_error_implied_mode(Var0, VarInst0, InitialInst),
+            mode_info_error(WaitingVars, ModeError, !ModeInfo)
         )
     ;
         inst_is_bound(ModuleInfo0, InitialInst)
@@ -4020,8 +4242,8 @@
         % This is the case we can't handle.
         Var = Var0,
         set.singleton_set(WaitingVars, Var0),
-        mode_info_error(WaitingVars,
-            mode_error_implied_mode(Var0, VarInst0, InitialInst), !ModeInfo)
+        ModeError = mode_error_implied_mode(Var0, VarInst0, InitialInst),
+        mode_info_error(WaitingVars, ModeError, !ModeInfo)
     ;
         % This is the simple case of implied modes,
         % where the declared mode was free -> ...
@@ -4066,10 +4288,10 @@
             module_info_get_name(ModuleInfo, ModuleName)
         ),
         NonLocals = set.make_singleton_set(Var),
-        InstmapDeltaAL = [Var - Inst],
-        InstmapDelta = instmap_delta_from_assoc_list(InstmapDeltaAL),
+        InstMapDeltaAL = [Var - Inst],
+        InstMapDelta = instmap_delta_from_assoc_list(InstMapDeltaAL),
         build_call(ModuleName, PredName, [Var], [VarType], NonLocals,
-            InstmapDelta, Context, MaybeCallUnifyContext,
+            InstMapDelta, Context, MaybeCallUnifyContext,
             hlds_goal(GoalExpr, GoalInfo), !ModeInfo)
     ->
         InitVarGoal = hlds_goal(GoalExpr, GoalInfo),
@@ -4099,7 +4321,7 @@
     mode_info::in, mode_info::out) is semidet.
 
 build_call(CalleeModuleName, CalleePredName, ArgVars, ArgTypes, NonLocals,
-        InstmapDelta, Context, CallUnifyContext, Goal, !ModeInfo) :-
+        InstMapDelta, Context, MaybeCallUnifyContext, Goal, !ModeInfo) :-
     mode_info_get_module_info(!.ModeInfo, ModuleInfo0),
 
     % Get the relevant information for the procedure we are transforming
@@ -4135,13 +4357,13 @@
     goal_info_init(GoalInfo0),
     goal_info_set_context(Context, GoalInfo0, GoalInfo1),
     goal_info_set_nonlocals(NonLocals, GoalInfo1, GoalInfo2),
-    goal_info_set_instmap_delta(InstmapDelta, GoalInfo2, GoalInfo),
+    goal_info_set_instmap_delta(InstMapDelta, GoalInfo2, GoalInfo),
 
     % Do the transformation for this call goal.
     SymName = qualified(CalleeModuleName, CalleePredName),
     polymorphism_process_new_call(CalleePredInfo, CalleeProcInfo,
-        CalleePredId, CalleeProcId, ArgVars, not_builtin, CallUnifyContext,
-        SymName, GoalInfo, Goal, PolyInfo0, PolyInfo),
+        CalleePredId, CalleeProcId, ArgVars, not_builtin,
+        MaybeCallUnifyContext, SymName, GoalInfo, Goal, PolyInfo0, PolyInfo),
 
     % Update the information in the predicate table.
     polymorphism.poly_info_extract(PolyInfo, PredInfo0, PredInfo,
Index: compiler/options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.655
diff -u -b -r1.655 options.m
--- compiler/options.m	14 Sep 2009 03:30:30 -0000	1.655
+++ compiler/options.m	21 Sep 2009 10:49:46 -0000
@@ -1444,10 +1444,7 @@
     intermod_inline_simple_threshold    -   int(5),
                                         % Has no effect until
                                         % --intermodule-optimization.
-    from_ground_term_threshold          -   int(1000000),
-                                        % This limit has been increased
-                                        % until bugs 93 and 94 have
-                                        % been fixed.
+    from_ground_term_threshold          -   int(5),
     common_struct                       -   bool(no),
     common_struct_preds                 -   string(""),
     common_goal                         -   bool(yes),
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.347
diff -u -b -r1.347 polymorphism.m
--- compiler/polymorphism.m	16 Sep 2009 02:32:54 -0000	1.347
+++ compiler/polymorphism.m	21 Sep 2009 15:17:29 -0000
@@ -218,8 +218,8 @@
     is det.
 
     % Add the type_info variables for a new call goal.  This predicate assumes
-    % that process_module has already been run so the called pred
-    % has already been processed.
+    % that process_module has already been run so the called pred has already
+    % been processed.
     %
     % XXX This predicate does not yet handle calls whose arguments include
     % existentially quantified types or type class constraints.
@@ -2136,14 +2136,11 @@
 
 %-----------------------------------------------------------------------------%
 
-    % document me
-    %
-    % XXX This predicate does not yet handle calls whose arguments include
-    % existentially quantified types or type class constraints.
-    %
 polymorphism_process_new_call(CalleePredInfo, CalleeProcInfo, PredId, ProcId,
         CallArgs0, BuiltinState, MaybeCallUnifyContext, SymName,
         GoalInfo0, Goal, !Info) :-
+    % document me better
+    %
     poly_info_get_typevarset(!.Info, TVarSet0),
     poly_info_get_var_types(!.Info, VarTypes0),
     ActualArgTypes0 = map.apply_to_list(CallArgs0, VarTypes0),
Index: compiler/quantification.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/quantification.m,v
retrieving revision 1.135
diff -u -b -r1.135 quantification.m
--- compiler/quantification.m	8 Sep 2009 02:43:37 -0000	1.135
+++ compiler/quantification.m	22 Sep 2009 05:57:11 -0000
@@ -620,8 +620,18 @@
             GoalExpr = shorthand(ShortHand)
         ;
             ShortHand0 = bi_implication(LHS, RHS),
+            (
+                NonLocalsToRecompute = ordinary_nonlocals_maybe_lambda,
             implicitly_quantify_goal_quant_info_bi_implication(LHS, RHS,
-                GoalExpr, GoalInfo0, NonLocalsToRecompute, !Info)
+                    GoalExpr, GoalInfo0, !Info)
+            ;
+                ( NonLocalsToRecompute = ordinary_nonlocals_no_lambda
+                ; NonLocalsToRecompute = code_gen_nonlocals_no_lambda
+                ),
+                % Any bi_implications should have been expanded out by now.
+                unexpected(this_file,
+                    "implicitly_quantify_goal_quant_info_2: bi_implication")
+            )
         ),
         goal_expr_vars_bitset(NonLocalsToRecompute, GoalExpr0,
             PossiblyNonLocalGoalVars0)
@@ -779,17 +789,12 @@
 
 :- pred implicitly_quantify_goal_quant_info_bi_implication(
     hlds_goal, hlds_goal, hlds_goal_expr, hlds_goal_info,
-    nonlocals_to_recompute, quant_info, quant_info).
-:- mode implicitly_quantify_goal_quant_info_bi_implication(in, in, out, in,
-    in(ordinary_nonlocals_maybe_lambda), in, out) is det.
-:- mode implicitly_quantify_goal_quant_info_bi_implication(in, in, out, in,
-    in(ordinary_nonlocals_no_lambda), in, out) is det.
+    quant_info, quant_info).
 :- mode implicitly_quantify_goal_quant_info_bi_implication(in, in, out, in,
-    in(code_gen_nonlocals_no_lambda), in, out) is det.
+    in, out) is det.
 
 implicitly_quantify_goal_quant_info_bi_implication(LHS0, RHS0, GoalExpr,
-        OldGoalInfo, NonLocalsToRecompute, !Info) :-
-
+        OldGoalInfo, !Info) :-
     % Get the initial values of various settings.
     get_quant_vars(!.Info, QuantVars0),
     get_outside(!.Info, OutsideVars0),
@@ -806,25 +811,15 @@
 
     % Prepare for quantifying the LHS: add variables from the RHS to the
     % outside vars and the outside lambda vars sets.
-    (
-        NonLocalsToRecompute = ordinary_nonlocals_maybe_lambda,
-        goal_vars_both_maybe_lambda(NonLocalsToRecompute, RHS0,
-            RHS_Vars, RHS_LambdaVars)
-    ;
-        ( NonLocalsToRecompute = ordinary_nonlocals_no_lambda
-        ; NonLocalsToRecompute = code_gen_nonlocals_no_lambda
-        ),
-        goal_vars_both_no_lambda(NonLocalsToRecompute, RHS0, RHS_Vars),
-        RHS_LambdaVars = init
-    ),
+    goal_vars_both_maybe_lambda_and_bi_impl(RHS0, RHS_Vars, RHS_LambdaVars),
     union(OutsideVars1, RHS_Vars, LHS_OutsideVars),
     union(LambdaOutsideVars1, RHS_LambdaVars, LHS_LambdaOutsideVars),
 
     % Quantify the LHS.
     set_outside(LHS_OutsideVars, !Info),
     set_lambda_outside(LHS_LambdaOutsideVars, !Info),
-    implicitly_quantify_goal_quant_info(LHS0, LHS, NonLocalsToRecompute,
-        !Info),
+    implicitly_quantify_goal_quant_info(LHS0, LHS,
+        ordinary_nonlocals_maybe_lambda, !Info),
     get_nonlocals(!.Info, LHS_NonLocalVars),
 
     % Prepare for quantifying the RHS: add nonlocals from the LHS to the
@@ -837,8 +832,8 @@
     % Quantify the RHS.
     set_outside(RHS_OutsideVars, !Info),
     set_lambda_outside(RHS_LambdaOutsideVars, !Info),
-    implicitly_quantify_goal_quant_info(RHS0, RHS, NonLocalsToRecompute,
-        !Info),
+    implicitly_quantify_goal_quant_info(RHS0, RHS,
+        ordinary_nonlocals_maybe_lambda, !Info),
     get_nonlocals(!.Info, RHS_NonLocalVars),
 
     % Compute the nonlocals for this goal.
@@ -853,7 +848,7 @@
     set_lambda_outside(LambdaOutsideVars0, !Info),
     set_quant_vars(QuantVars0, !Info),
 
-    % We've figured out the quantification.
+    % We have figured out the quantification.
     % Now expand the bi-implication according to the usual rules:
     %   LHS <=> RHS
     % ===>
@@ -864,11 +859,11 @@
     Context = goal_info_get_context(OldGoalInfo),
     goal_info_init(GoalInfo0),
     goal_info_set_context(Context, GoalInfo0, GoalInfo1),
-    set_goal_nonlocals(LHS_NonLocalVars, NonLocalsToRecompute,
+    set_goal_nonlocals(LHS_NonLocalVars, ordinary_nonlocals_maybe_lambda,
         GoalInfo1, LHS_GI, !Info),
-    set_goal_nonlocals(RHS_NonLocalVars, NonLocalsToRecompute,
+    set_goal_nonlocals(RHS_NonLocalVars, ordinary_nonlocals_maybe_lambda,
         GoalInfo1, RHS_GI, !Info),
-    set_goal_nonlocals(NonLocalVars, NonLocalsToRecompute,
+    set_goal_nonlocals(NonLocalVars, ordinary_nonlocals_maybe_lambda,
         GoalInfo1, GI, !Info),
     NotLHS = hlds_goal(negation(LHS), LHS_GI),
     NotRHS = hlds_goal(negation(RHS), RHS_GI),
@@ -880,9 +875,9 @@
     ReverseImplicationExpr0 =
         negation(hlds_goal(conj(plain_conj, [RHS, NotLHS]), GI)),
     ReverseImplication0 = hlds_goal(ReverseImplicationExpr0, GI),
-    goal_vars_bitset(NonLocalsToRecompute, ReverseImplication0, GoalVars),
+    goal_vars_bitset_maybe_lambda_and_bi_impl(ReverseImplication0, GoalVars),
     difference(GoalVars, NonLocalVars, RenameVars),
-    rename_apart(RenameVars, _, NonLocalsToRecompute,
+    rename_apart(RenameVars, _, ordinary_nonlocals_maybe_lambda,
         ReverseImplication0, ReverseImplication, !Info),
 
     GoalExpr = conj(plain_conj, [ForwardsImplication, ReverseImplication]).
@@ -1271,6 +1266,17 @@
         !Set, !LambdaSet),
     conj_vars_maybe_lambda(NonLocalsToRecompute, Goals, !Set, !LambdaSet).
 
+:- pred conj_vars_maybe_lambda_and_bi_impl(list(hlds_goal),
+    set_of_var, set_of_var, set_of_var, set_of_var).
+:- mode conj_vars_maybe_lambda_and_bi_impl(
+    in, in, out, in, out) is det.
+
+conj_vars_maybe_lambda_and_bi_impl([], !Set, !LambdaSet).
+conj_vars_maybe_lambda_and_bi_impl([Goal | Goals], !Set, !LambdaSet) :-
+    Goal = hlds_goal(GoalExpr, _GoalInfo),
+    goal_expr_vars_maybe_lambda_and_bi_impl_2(GoalExpr, !Set, !LambdaSet),
+    conj_vars_maybe_lambda_and_bi_impl(Goals, !Set, !LambdaSet).
+
 :- pred conj_vars_no_lambda(nonlocals_to_recompute, list(hlds_goal),
     set_of_var, set_of_var).
 :- mode conj_vars_no_lambda(in(ordinary_nonlocals_no_lambda),
@@ -1309,6 +1315,31 @@
     union(GoalsSet, !Set),
     union(GoalsLambdaSet, !LambdaSet).
 
+:- pred disj_vars_maybe_lambda_and_bi_impl(list(hlds_goal),
+    set_of_var, set_of_var, set_of_var, set_of_var).
+:- mode disj_vars_maybe_lambda_and_bi_impl(
+    in, in, out, in, out) is det.
+
+disj_vars_maybe_lambda_and_bi_impl(Goals, !Set, !LambdaSet) :-
+    compute_disj_vars_maybe_lambda_and_bi_impl(Goals,
+        [], GoalSets, [], GoalLambdaSets),
+    (
+        GoalSets = [],
+        GoalsSet = init
+    ;
+        GoalSets = [_ | _],
+        union_list(GoalSets, GoalsSet)
+    ),
+    (
+        GoalLambdaSets = [],
+        GoalsLambdaSet = init
+    ;
+        GoalLambdaSets = [_ | _],
+        union_list(GoalLambdaSets, GoalsLambdaSet)
+    ),
+    union(GoalsSet, !Set),
+    union(GoalsLambdaSet, !LambdaSet).
+
 :- pred disj_vars_no_lambda(nonlocals_to_recompute, list(hlds_goal),
     set_of_var, set_of_var).
 :- mode disj_vars_no_lambda(in(ordinary_nonlocals_no_lambda),
@@ -1342,6 +1373,19 @@
     compute_disj_vars_maybe_lambda(NonLocalsToRecompute, Goals,
         !Sets, !LambdaSets).
 
+:- pred compute_disj_vars_maybe_lambda_and_bi_impl(list(hlds_goal),
+    list(set_of_var), list(set_of_var), list(set_of_var), list(set_of_var)).
+:- mode compute_disj_vars_maybe_lambda_and_bi_impl(
+    in, in, out, in, out) is det.
+
+compute_disj_vars_maybe_lambda_and_bi_impl([], !Sets, !LambdaSets).
+compute_disj_vars_maybe_lambda_and_bi_impl([Goal | Goals],
+        !Sets, !LambdaSets) :-
+    goal_vars_both_maybe_lambda_and_bi_impl(Goal, GoalSet, GoalLambdaSet),
+    !:Sets = [GoalSet | !.Sets],
+    !:LambdaSets = [GoalLambdaSet | !.LambdaSets],
+    compute_disj_vars_maybe_lambda_and_bi_impl(Goals, !Sets, !LambdaSets).
+
 :- pred compute_disj_vars_no_lambda(nonlocals_to_recompute, list(hlds_goal),
     list(set_of_var), list(set_of_var)).
 :- mode compute_disj_vars_no_lambda(in(ordinary_nonlocals_no_lambda),
@@ -1380,6 +1424,31 @@
     union(CasesSet, !Set),
     union(CasesLambdaSet, !LambdaSet).
 
+:- pred case_vars_maybe_lambda_and_bi_impl(list(case),
+    set_of_var, set_of_var, set_of_var, set_of_var).
+:- mode case_vars_maybe_lambda_and_bi_impl(
+    in, in, out, in, out) is det.
+
+case_vars_maybe_lambda_and_bi_impl(Cases, !Set, !LambdaSet) :-
+    compute_case_vars_maybe_lambda_and_bi_impl(Cases,
+        [], CaseSets, [], CaseLambdaSets),
+    (
+        CaseSets = [],
+        unexpected(this_file, "case_vars: no cases (1)")
+    ;
+        CaseSets = [_ | _],
+        union_list(CaseSets, CasesSet)
+    ),
+    (
+        CaseLambdaSets = [],
+        unexpected(this_file, "case_vars: no cases (2)")
+    ;
+        CaseLambdaSets = [_ | _],
+        union_list(CaseLambdaSets, CasesLambdaSet)
+    ),
+    union(CasesSet, !Set),
+    union(CasesLambdaSet, !LambdaSet).
+
 :- pred case_vars_no_lambda(nonlocals_to_recompute, list(case),
     set_of_var, set_of_var).
 :- mode case_vars_no_lambda(in(ordinary_nonlocals_no_lambda),
@@ -1414,6 +1483,20 @@
     compute_case_vars_maybe_lambda(NonLocalsToRecompute, Cases,
         !Sets, !LambdaSets).
 
+:- pred compute_case_vars_maybe_lambda_and_bi_impl(list(case),
+    list(set_of_var), list(set_of_var), list(set_of_var), list(set_of_var)).
+:- mode compute_case_vars_maybe_lambda_and_bi_impl(
+    in, in, out, in, out) is det.
+
+compute_case_vars_maybe_lambda_and_bi_impl([], !Sets, !LambdaSets).
+compute_case_vars_maybe_lambda_and_bi_impl([Case | Cases],
+        !Sets, !LambdaSets) :-
+    Case = case(_MainConsId, _OtherConsIds, Goal),
+    goal_vars_both_maybe_lambda_and_bi_impl(Goal, GoalSet, GoalLambdaSet),
+    !:Sets = [GoalSet | !.Sets],
+    !:LambdaSets = [GoalLambdaSet | !.LambdaSets],
+    compute_case_vars_maybe_lambda_and_bi_impl(Cases, !Sets, !LambdaSets).
+
 :- pred compute_case_vars_no_lambda(nonlocals_to_recompute, list(case),
     list(set_of_var), list(set_of_var)).
 :- mode compute_case_vars_no_lambda(in(ordinary_nonlocals_no_lambda),
@@ -1515,6 +1598,14 @@
         Set, LambdaSet),
     BothSet = union(Set, LambdaSet).
 
+:- pred goal_vars_bitset_maybe_lambda_and_bi_impl(hlds_goal, set_of_var).
+:- mode goal_vars_bitset_maybe_lambda_and_bi_impl(in, out) is det.
+
+goal_vars_bitset_maybe_lambda_and_bi_impl(Goal, BothSet) :-
+    Goal = hlds_goal(GoalExpr, _),
+    goal_expr_vars_both_maybe_lambda_and_bi_impl(GoalExpr, Set, LambdaSet),
+    BothSet = union(Set, LambdaSet).
+
 :- pred goal_vars_bitset_no_lambda(nonlocals_to_recompute,
     hlds_goal, set_of_var).
 :- mode goal_vars_bitset_no_lambda(in(ordinary_nonlocals_no_lambda),
@@ -1588,6 +1679,20 @@
     goal_expr_vars_both_maybe_lambda(NonLocalsToRecompute, GoalExpr,
         Set, LambdaSet).
 
+    % goal_vars_both_maybe_lambda_and_bi_impl(NonLocalsToRecompute, Goal,
+    %   NonLambdaSet, LambdaSet):
+    %
+    % As goal_vars_both_maybe_lambda, but include all the variables from
+    % from_groun_term scopes, not just the term variable.
+    %
+:- pred goal_vars_both_maybe_lambda_and_bi_impl(hlds_goal,
+    set_of_var, set_of_var).
+:- mode goal_vars_both_maybe_lambda_and_bi_impl(in, out, out) is det.
+
+goal_vars_both_maybe_lambda_and_bi_impl(Goal, Set, LambdaSet) :-
+    Goal = hlds_goal(GoalExpr, _),
+    goal_expr_vars_both_maybe_lambda_and_bi_impl(GoalExpr, Set, LambdaSet).
+
 :- pred goal_vars_both_no_lambda(nonlocals_to_recompute, hlds_goal,
     set_of_var).
 :- mode goal_vars_both_no_lambda(in(ordinary_nonlocals_no_lambda),
@@ -1611,6 +1716,16 @@
     goal_expr_vars_maybe_lambda_2(NonLocalsToRecompute, GoalExpr, Set0, Set,
         LambdaSet0, LambdaSet).
 
+:- pred goal_expr_vars_both_maybe_lambda_and_bi_impl(hlds_goal_expr,
+    set_of_var, set_of_var).
+:- mode goal_expr_vars_both_maybe_lambda_and_bi_impl(in, out, out) is det.
+
+goal_expr_vars_both_maybe_lambda_and_bi_impl(GoalExpr, Set, LambdaSet) :-
+    Set0 = init,
+    LambdaSet0 = init,
+    goal_expr_vars_maybe_lambda_and_bi_impl_2(GoalExpr, Set0, Set,
+        LambdaSet0, LambdaSet).
+
 :- pred goal_expr_vars_both_no_lambda(nonlocals_to_recompute, hlds_goal_expr,
     set_of_var).
 :- mode goal_expr_vars_both_no_lambda(in(ordinary_nonlocals_no_lambda),
@@ -1786,6 +1901,154 @@
         )
     ).
 
+:- pred goal_expr_vars_maybe_lambda_and_bi_impl_2(hlds_goal_expr,
+    set_of_var, set_of_var, set_of_var, set_of_var).
+:- mode goal_expr_vars_maybe_lambda_and_bi_impl_2(
+    in, in, out, in, out) is det.
+
+goal_expr_vars_maybe_lambda_and_bi_impl_2(GoalExpr, !Set, !LambdaSet) :-
+    (
+        GoalExpr = unify(LHS, RHS, _, Unification, _),
+        insert(!.Set, LHS, !:Set),
+        (
+            Unification = construct(_, _, _, _, How, _, SubInfo),
+            (
+                How = reuse_cell(cell_to_reuse(ReuseVar, _, _)),
+                insert(!.Set, ReuseVar, !:Set)
+            ;
+                How = construct_in_region(RegionVar),
+                insert(!.Set, RegionVar, !:Set)
+            ;
+                ( How = construct_statically
+                ; How = construct_dynamically
+                )
+            ),
+            (
+                SubInfo = construct_sub_info(_, MaybeSize),
+                MaybeSize = yes(dynamic_size(SizeVar))
+            ->
+                insert(!.Set, SizeVar, !:Set)
+            ;
+                true
+            )
+        ;
+            Unification = complicated_unify(_, _, TypeInfoVars),
+            insert_list(!.Set, TypeInfoVars, !:Set)
+        ;
+            ( Unification = deconstruct(_, _, _, _, _, _)
+            ; Unification = assign(_, _)
+            ; Unification = simple_test(_, _)
+            )
+        ),
+        unify_rhs_vars_maybe_lambda_and_bi_impl(RHS, !Set, !LambdaSet)
+    ;
+        GoalExpr = plain_call(_, _, ArgVars, _, _, _),
+        insert_list(!.Set, ArgVars, !:Set)
+    ;
+        GoalExpr = generic_call(GenericCall, ArgVars1, _, _),
+        goal_util.generic_call_vars(GenericCall, ArgVars0),
+        insert_list(!.Set, ArgVars0, !:Set),
+        insert_list(!.Set, ArgVars1, !:Set)
+    ;
+        GoalExpr = call_foreign_proc(_, _, _, Args, ExtraArgs, _, _),
+        Vars = list.map(foreign_arg_var, Args),
+        ExtraVars = list.map(foreign_arg_var, ExtraArgs),
+        list.append(Vars, ExtraVars, AllVars),
+        insert_list(!.Set, AllVars, !:Set)
+    ;
+        GoalExpr = conj(ConjType, Goals),
+        (
+            ConjType = plain_conj
+        ;
+            ConjType = parallel_conj
+        ),
+        conj_vars_maybe_lambda_and_bi_impl(Goals, !Set, !LambdaSet)
+    ;
+        GoalExpr = disj(Goals),
+        disj_vars_maybe_lambda_and_bi_impl(Goals, !Set, !LambdaSet)
+    ;
+        GoalExpr = switch(Var, _Det, Cases),
+        insert(!.Set, Var, !:Set),
+        case_vars_maybe_lambda_and_bi_impl(Cases, !Set, !LambdaSet)
+    ;
+        GoalExpr = if_then_else(Vars, Cond, Then, Else),
+        % This code does the following:
+        %     !:Set = !.Set + ( (vars(Cond) + vars(Then)) \ Vars ) + vars(Else)
+        % where `+' is set union and `\' is relative complement.
+        goal_vars_both_maybe_lambda_and_bi_impl(Cond,
+            CondSet, CondLambdaSet),
+        goal_vars_both_maybe_lambda_and_bi_impl(Then,
+            ThenSet, ThenLambdaSet),
+        goal_vars_both_maybe_lambda_and_bi_impl(Else,
+            ElseSet, ElseLambdaSet),
+        union(CondSet, ThenSet, CondThenSet),
+        union(CondLambdaSet, ThenLambdaSet, CondThenLambdaSet),
+        delete_list(CondThenSet, Vars, SomeCondThenSet),
+        delete_list(CondThenLambdaSet, Vars, SomeCondThenLambdaSet),
+        union(!.Set, SomeCondThenSet, !:Set),
+        union(!.LambdaSet, SomeCondThenLambdaSet, !:LambdaSet),
+        union(!.Set, ElseSet, !:Set),
+        union(!.LambdaSet, ElseLambdaSet, !:LambdaSet)
+    ;
+        GoalExpr = negation(SubGoal),
+        SubGoal = hlds_goal(SubGoalExpr, _SubGoalInfo),
+        goal_expr_vars_maybe_lambda_and_bi_impl_2(SubGoalExpr,
+            !Set, !LambdaSet)
+    ;
+        GoalExpr = scope(Reason, SubGoal),
+        Set0 = !.Set,
+        LambdaSet0 = !.LambdaSet,
+        (
+            ( Reason = promise_purity(_)
+            ; Reason = commit(_)
+            ; Reason = barrier(_)
+            ; Reason = trace_goal(_, _, _, _, _)
+            ),
+            goal_vars_both_maybe_lambda_and_bi_impl(SubGoal,
+                !:Set, !:LambdaSet)
+        ;
+            Reason = exist_quant(Vars),
+            goal_vars_both_maybe_lambda_and_bi_impl(SubGoal,
+                !:Set, !:LambdaSet),
+            delete_list(!.Set, Vars, !:Set),
+            delete_list(!.LambdaSet, Vars, !:LambdaSet)
+        ;
+            Reason = promise_solutions(Vars, _Kind),
+            goal_vars_both_maybe_lambda_and_bi_impl(SubGoal,
+                !:Set, !:LambdaSet),
+            insert_list(!.Set, Vars, !:Set)
+        ;
+            Reason = from_ground_term(_TermVar, _Kind),
+            goal_vars_both_maybe_lambda_and_bi_impl(SubGoal,
+                !:Set, !:LambdaSet)
+            % TermVar should have been put into the relevant sets when we
+            % processed SubGoal, since it should appear in SubGoal.
+        ),
+        union(Set0, !Set),
+        union(LambdaSet0, !LambdaSet)
+    ;
+        GoalExpr = shorthand(ShortHand),
+        (
+            ShortHand = atomic_goal(_GoalType, Outer, Inner,
+                _MaybeOutputVars, MainGoal, OrElseGoals, _OrElseInners),
+            % XXX STM
+            Outer = atomic_interface_vars(OuterDI, OuterUO),
+            Inner = atomic_interface_vars(InnerDI, InnerUO),
+            insert_list(!.Set, [OuterDI, OuterUO, InnerDI, InnerUO], !:Set),
+            disj_vars_maybe_lambda_and_bi_impl([MainGoal | OrElseGoals],
+                !Set, !LambdaSet)
+        ;
+            ShortHand = try_goal(_MaybeIO, _ResultVar, SubGoal),
+            % IO state variables and ResultVar are already in SubGoal.
+            SubGoal = hlds_goal(SubGoalExpr, _SubGoalInfo),
+            goal_expr_vars_maybe_lambda_and_bi_impl_2(SubGoalExpr,
+                !Set, !LambdaSet)
+        ;
+            ShortHand = bi_implication(LHS, RHS),
+            conj_vars_maybe_lambda_and_bi_impl([LHS, RHS], !Set, !LambdaSet)
+        )
+    ).
+
 :- pred goal_expr_vars_no_lambda_2(nonlocals_to_recompute, hlds_goal_expr,
     set_of_var, set_of_var).
 :- mode goal_expr_vars_no_lambda_2(in(ordinary_nonlocals_no_lambda),
@@ -1946,6 +2209,27 @@
         union(!.LambdaSet, GoalVars1, !:LambdaSet)
     ).
 
+:- pred unify_rhs_vars_maybe_lambda_and_bi_impl(unify_rhs,
+    set_of_var, set_of_var, set_of_var, set_of_var).
+:- mode unify_rhs_vars_maybe_lambda_and_bi_impl(
+    in, in, out, in, out) is det.
+
+unify_rhs_vars_maybe_lambda_and_bi_impl(RHS, !Set, !LambdaSet) :-
+    (
+        RHS = rhs_var(Y), 
+        insert(!.Set, Y, !:Set)
+    ;
+        RHS = rhs_functor(_, _, ArgVars),
+        insert_list(!.Set, ArgVars, !:Set)
+    ;
+        RHS = rhs_lambda_goal(_, _, _, _, _, LambdaVars, _, _, Goal),
+        % Note that the NonLocals list is not counted, since all the
+        % variables in that list must occur in the goal.
+        goal_vars_bitset_maybe_lambda_and_bi_impl(Goal, GoalVars),
+        delete_list(GoalVars, LambdaVars, GoalVars1),
+        union(!.LambdaSet, GoalVars1, !:LambdaSet)
+    ).
+
 :- pred unify_rhs_vars_no_lambda(nonlocals_to_recompute, unify_rhs,
     maybe(list(needs_update)), set_of_var, set_of_var).
 :- mode unify_rhs_vars_no_lambda(in(ordinary_nonlocals_no_lambda),
Index: compiler/superhomogeneous.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/superhomogeneous.m,v
retrieving revision 1.35
diff -u -b -r1.35 superhomogeneous.m
--- compiler/superhomogeneous.m	8 Sep 2009 02:43:39 -0000	1.35
+++ compiler/superhomogeneous.m	21 Sep 2009 07:26:41 -0000
@@ -431,8 +431,10 @@
             GoalExpr = scope(from_ground_term(LHSVar, Kind), SubGoal),
             Goal = hlds_goal(GoalExpr, GoalInfo)
         ;
-            unexpected(this_file,
-                "do_unravel_unification: from_ground_term not conj")
+            % This can happen if we unravel large ground term that happens to
+            % be a lambda expression; the conjunction will then be *inside*
+            % the rhs_lambda_goal.
+            Goal = Goal0
         )
     ;
         Goal = Goal0
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/base64
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/fixed
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_allegro
cvs diff: Diffing extras/graphics/mercury_allegro/examples
cvs diff: Diffing extras/graphics/mercury_allegro/samples
cvs diff: Diffing extras/graphics/mercury_allegro/samples/demo
cvs diff: Diffing extras/graphics/mercury_allegro/samples/mandel
cvs diff: Diffing extras/graphics/mercury_allegro/samples/pendulum2
cvs diff: Diffing extras/graphics/mercury_allegro/samples/speed
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/log4m
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/mopenssl
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/net
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/posix/samples
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/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/c_interface/standalone_c
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/solver_types
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 ssdb
cvs diff: Diffing tests
cvs diff: Diffing tests/analysis
cvs diff: Diffing tests/analysis/ctgc
cvs diff: Diffing tests/analysis/excp
cvs diff: Diffing tests/analysis/ext
cvs diff: Diffing tests/analysis/sharing
cvs diff: Diffing tests/analysis/table
cvs diff: Diffing tests/analysis/trail
cvs diff: Diffing tests/analysis/unused_args
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.41
diff -u -b -r1.41 Mercury.options
--- tests/hard_coded/Mercury.options	21 Sep 2009 04:09:06 -0000	1.41
+++ tests/hard_coded/Mercury.options	22 Sep 2009 06:05:20 -0000
@@ -21,6 +21,7 @@
 MCFLAGS-float_consistency =	--optimize-constant-propagation
 MCFLAGS-foreign_enum_mod1 = 	--intermodule-optimization
 MCFLAGS-foreign_enum_mod2 = 	--intermodule-optimization
+MCFLAGS-from_ground_term_bug = 	--from-ground-term-threshold=4
 MCFLAGS-func_test	=	--infer-all
 MCFLAGS-ho_order	=	--optimize-higher-order
 MCFLAGS-ho_order2	=	--optimize-higher-order
@@ -47,6 +48,7 @@
 MCFLAGS-simplify_multi_arm_switch = -O3
 MCFLAGS-uncond_reuse	    =	--ctgc
 MCFLAGS-uncond_reuse_bad    =	--ctgc
+MCFLAGS-uo_regression1      =	--from-ground-term-threshold=4
 
 # We disable intermodule-optimization here because it isn't compatible with
 # intermodule-analysis.
@@ -94,7 +96,7 @@
 				--transitive-intermodule-optimization
 MCFLAGS-trans_intermod_user_equality3 = --intermodule-optimization \
 				--transitive-intermodule-optimization
-MCFLAGS-type_qual	= 	--infer-all
+MCFLAGS-type_qual	= 	--infer-all --from-ground-term-threshold=4
 MCFLAGS-type_spec	=	--user-guided-type-specialization
 MCFLAGS-existential_types_test = --infer-all
 MCFLAGS-existential_float = --infer-all
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.381
diff -u -b -r1.381 Mmakefile
--- tests/hard_coded/Mmakefile	21 Sep 2009 04:09:06 -0000	1.381
+++ tests/hard_coded/Mmakefile	22 Sep 2009 06:01:52 -0000
@@ -105,6 +105,7 @@
 	foreign_type3 \
 	frameopt_pragma_redirect \
 	free_free_mode \
+	from_ground_term_bug \
 	func_and_pred \
 	func_ctor_ambig \
 	func_test \
@@ -279,6 +280,7 @@
 	uniq_duplicate_call \
 	unused_float_box_test \
 	unusual_name_mutable \
+	uo_regression1 \
 	user_compare \
 	user_defined_equality2 \
 	value_enum \
Index: tests/hard_coded/type_qual.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/type_qual.exp,v
retrieving revision 1.4
diff -u -b -r1.4 type_qual.exp
--- tests/hard_coded/type_qual.exp	17 Jan 2003 05:57:05 -0000	1.4
+++ tests/hard_coded/type_qual.exp	22 Sep 2009 06:07:51 -0000
@@ -14,3 +14,4 @@
 list.list(string)
 []
 bi-implication succeeded
+bi-implication succeeded
Index: tests/hard_coded/type_qual.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/type_qual.m,v
retrieving revision 1.5
diff -u -b -r1.5 type_qual.m
--- tests/hard_coded/type_qual.m	22 Mar 2006 02:56:30 -0000	1.5
+++ tests/hard_coded/type_qual.m	22 Sep 2009 05:36:04 -0000
@@ -19,7 +19,8 @@
 	test4,
 	test5(yes),
 	test5(no),
-	test6.
+	test6,
+	test7.
 
 :- pred test1(io__state::di, io__state::uo) is det.
 
@@ -84,6 +85,23 @@
 		io__write_string("bi-implication failed\n")
 	).
 
+:- pred test7(io__state::di, io__state::uo) is det.
+
+test7 -->
+	% Test the bi-implication in both directions, since for efficiency,
+	% quantification handles the LHS and RHS differently.
+	(
+		{
+			X = type_of([1, 2, 3])
+		<=>
+			X = type_of([] : list(int))
+		}
+	->
+		io__write_string("bi-implication succeeded\n")
+	;
+		io__write_string("bi-implication failed\n")
+	).
+
 % inferred
 empty_list = [] : list(int).
 
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/par_conj
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/stm
cvs diff: Diffing tests/stm/orig
cvs diff: Diffing tests/stm/orig/stm-compiler
cvs diff: Diffing tests/stm/orig/stm-compiler/test1
cvs diff: Diffing tests/stm/orig/stm-compiler/test10
cvs diff: Diffing tests/stm/orig/stm-compiler/test2
cvs diff: Diffing tests/stm/orig/stm-compiler/test3
cvs diff: Diffing tests/stm/orig/stm-compiler/test4
cvs diff: Diffing tests/stm/orig/stm-compiler/test5
cvs diff: Diffing tests/stm/orig/stm-compiler/test6
cvs diff: Diffing tests/stm/orig/stm-compiler/test7
cvs diff: Diffing tests/stm/orig/stm-compiler/test8
cvs diff: Diffing tests/stm/orig/stm-compiler/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/stmqueue
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test10
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test11
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test9
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 messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------



More information about the reviews mailing list