diff: fix overzealous sanity check

[Zoltan Somogyi-2]

compiler/dep_par_conj.m:
        Relax an overly restrictive sanity check, and add infrastructure
        for debugging similar problems in the future.

compiler/options.m:
        Add the developer-only option for that infrastructure.

Zoltan.

cvs diff: Diffing .
Index: dep_par_conj.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dep_par_conj.m,v
retrieving revision 1.37
diff -u -b -r1.37 dep_par_conj.m
--- dep_par_conj.m 8 Sep 2009 02:43:31 -0000 1.37
+++ dep_par_conj.m 16 Oct 2009 07:56:52 -0000
@@ -145,6 +145,7 @@
 :- import_module check_hlds.mode_util.
 :- import_module check_hlds.purity.
 :- import_module hlds.goal_util.
+:- import_module hlds.hlds_out.
 :- import_module hlds.hlds_pred.
 :- import_module hlds.pred_table.
 :- import_module hlds.quantification.
@@ -1263,6 +1264,28 @@
         proc_info_get_goal(!.ProcInfo, !:Goal),
         !:SpecInfo = spec_info(DoneProcs, InitialModuleInfo, VarTypes,
             !.ModuleInfo, !.PendingParProcs, !.Pushability),
+
+        trace [compile_time(flag("debug-dep-par-conj")), io(!IO)] (
+            module_info_get_globals(!.ModuleInfo, Globals),
+            globals.lookup_accumulating_option(Globals, debug_dep_par_conj,
+                DebugDepParConjWords),
+            PredIdInt = pred_id_to_int(PredId),
+            PredIdStr = string.int_to_string(PredIdInt),
+            (
+                some [DebugDepParConjWord] (
+                    list.member(DebugDepParConjWord, DebugDepParConjWords),
+                    DebugDepParConjWord = PredIdStr
+                )
+            ->
+                OutInfo = init_hlds_out_info(Globals),
+                proc_info_get_varset(!.ProcInfo, VarSet),
+                write_goal(OutInfo, !.Goal, !.ModuleInfo, VarSet,
+                    yes, 0, "", !IO)
+            ;
+                true
+            )
+        ),
+
         specialize_sequences_in_goal(!Goal, !SpecInfo),
         !.SpecInfo = spec_info(_, _, _,
             !:ModuleInfo, !:PendingParProcs, !:Pushability),
@@ -2376,12 +2399,32 @@
             ; SignalElse = seen_signal_negligible_cost_after
             )
         ->
-            expect(negate(unify(SignalThen, not_seen_signal)),
-                this_file, "should_we_push_signal: ite mode mismatch"),
-            expect(negate(unify(SignalElse, not_seen_signal)),
-                this_file, "should_we_push_signal: ite mode mismatch"),
-            % Both arms of the if-then-else signal Var, but neither does
-            % anything nontrivial after the signal.
+            (
+                Then = hlds_goal(_, ThenInfo),
+                ThenDetism = goal_info_get_determinism(ThenInfo),
+                determinism_components(ThenDetism, _, ThenMaxSolns),
+                SignalThen = not_seen_signal,
+                not ( ThenMaxSolns = at_most_zero)
+            ->
+                unexpected(this_file,
+                    "should_we_push_signal: ite mode mismatch")
+            ;
+                true
+            ),
+            (
+                Else = hlds_goal(_, ElseInfo),
+                ElseDetism = goal_info_get_determinism(ElseInfo),
+                determinism_components(ElseDetism, _, ElseMaxSolns),
+                SignalElse = not_seen_signal,
+                not ( ElseMaxSolns = at_most_zero)
+            ->
+                unexpected(this_file,
+                    "should_we_push_signal: ite mode mismatch")
+            ;
+                true
+            ),
+            % Both arms of the if-then-else signal Var (if they succeed
+            % at all), but neither does anything nontrivial after the signal.
             !:Signal = seen_signal_negligible_cost_after
         ;
             expect(unify(SignalThen, not_seen_signal),
Index: options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.658
diff -u -b -r1.658 options.m
--- options.m 14 Oct 2009 05:28:41 -0000 1.658
+++ options.m 16 Oct 2009 07:56:52 -0000
@@ -154,6 +154,7 @@
     ;       debug_modes_minimal
     ;       debug_modes_verbose
     ;       debug_modes_pred_id
+    ;       debug_dep_par_conj
     ;       debug_det
     ;       debug_code_gen_pred_id
     ;       debug_opt
@@ -1080,6 +1081,7 @@
     debug_modes_minimal                 -   bool(no),
     debug_modes_verbose                 -   bool(no),
     debug_modes_pred_id                 -   int(-1),
+    debug_dep_par_conj                  -   accumulating([]),
     debug_det                           -   bool(no),
     debug_code_gen_pred_id              -   int(-1),
     debug_term                          -   bool(no),
@@ -1899,6 +1901,7 @@
 long_option("debug-modes-minimal",      debug_modes_minimal).
 long_option("debug-modes-verbose",      debug_modes_verbose).
 long_option("debug-modes-pred-id",      debug_modes_pred_id).
+long_option("debug-dep-par-conj",       debug_dep_par_conj).
 long_option("debug-determinism",        debug_det).
 long_option("debug-det",                debug_det).
 long_option("debug-code-gen-pred-id",   debug_code_gen_pred_id).
@@ -3436,6 +3439,13 @@
         "\tWith --debug-modes, restrict the debugging traces to the",
         "\tmode checking of the predicate or function with the specified",
         "\tpred id.",
+% --debug-dep-par-conj <n> is a developer only option,
+% and it is effective only if the compiler was compiled with the right
+% trace flags.
+%       "--debug-dep-par-conj <n>",
+%       "\tOutput detailed debugging traces during the dependent",
+%       "\tAND-parallelism transformation of the predicate with the",
+%       "\tpredicate id.",
         "--debug-det, --debug-determinism",
         "\tOutput detailed debugging traces of determinism analysis.",
 % --debug-code-gen-pred-id <n> is a developer only option,
cvs diff: Diffing notes
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews@...
Administrative Queries: owner-mercury-reviews@...
Subscriptions:          mercury-reviews-request@...
--------------------------------------------------------------------------