From 8bf95ce5dfb770c36359f435f0e58a0cd1ea781b Mon Sep 17 00:00:00 2001
From: Daniel Burrows <dburrows@debian.org>
Date: Sun, 12 Apr 2009 18:35:43 -0700
Subject: Show *all* backpropagated constraints, marking already-seen ones with
 dashed lines. This should make it a bit clearer what's happening in
 complicated search trees.

---
 tools/resolver-visualize/DotRender.hs    |  4 +++-
 tools/resolver-visualize/Resolver/Log.hs | 37 ++++++++++++++++----------------
 2 files changed, 22 insertions(+), 19 deletions(-)

diff --git a/tools/resolver-visualize/DotRender.hs b/tools/resolver-visualize/DotRender.hs
index bcc56322..269bb81d 100644
--- a/tools/resolver-visualize/DotRender.hs
+++ b/tools/resolver-visualize/DotRender.hs
@@ -112,7 +112,9 @@ dotPromotions params step =
          ++
          [ node (name $ printf "step%dbackprop%d" (stepOrder step) backpropNum)
            <<< set "label" (makeLabel $ backpropagationPromotion backprop)
-           <<< set "shape" "oval" 
+           <<< set "shape" "oval"
+           <<< backpropagationRedundant backprop `thenDo`
+               set "style" "dashed"
            | (backprop, backpropNum) <- zip (stepBackpropagations step) ([0..] :: [Integer]) ]
     where makeLabel p = if Set.size (promotionChoices p) <= 5
                         then printf "%s\n%s"
diff --git a/tools/resolver-visualize/Resolver/Log.hs b/tools/resolver-visualize/Resolver/Log.hs
index dde14a65..49aa1a51 100644
--- a/tools/resolver-visualize/Resolver/Log.hs
+++ b/tools/resolver-visualize/Resolver/Log.hs
@@ -71,10 +71,12 @@ data Successor = Successor { successorStep   :: ProcessingStep,
 
 -- | Represents backpropagating promotions up the search tree.
 --
--- The step; the promotion is the new
--- promotion that was generated by this propagation.
+-- The step is the step that the new promotion is attached to; the
+-- promotion is considered "redundant" if it was generated at some
+-- other step.
 data Backpropagation = Backpropagation { backpropagationStep :: ProcessingStep,
-                                         backpropagationPromotion :: Promotion }
+                                         backpropagationPromotion :: Promotion,
+                                         backpropagationRedundant :: Bool }
 
 data ProcessingStep = ProcessingStep { -- | How we got here; Nothing
                                        -- if this is the root node or
@@ -140,7 +142,7 @@ data PartialStep = PartialStep { -- | The search node generated by this step.
                                  -- step, in reverse order.
                                  pstepReverseSuccessors :: ![(Solution, LinkChoice, Bool)],
                                  -- | Backpropagations at this step, in reverse order.
-                                 pstepReverseBackpropagations :: ![(Solution, Promotion)],
+                                 pstepReverseBackpropagations :: ![(Solution, Promotion, Bool)],
                                  -- | Promotions generated at
                                  -- this step.
                                  pstepPromotions :: ![Promotion],
@@ -416,15 +418,14 @@ setPromotionBackpropagationState sol =
     do st <- get
        put $ st { logParsePromotionBackpropagationState = sol }
 
-addBackpropagatedPromotionToCurrentStep :: Solution -> Promotion -> LogParse ()
-addBackpropagatedPromotionToCurrentStep p sol =
-    p `seq` sol `seq`
-    modifyLastStep (\lastStep -> let pair   = (p, sol)
+addBackpropagatedPromotionToCurrentStep :: Solution -> Promotion -> Bool -> LogParse ()
+addBackpropagatedPromotionToCurrentStep p sol redundant =
+    p `seq` sol `seq` redundant `seq`
+    modifyLastStep (\lastStep -> let entry  = (p, sol, redundant)
                                      props  = pstepReverseBackpropagations lastStep
-                                     props' = pair:props in
-                                 pair `seq` props `seq` props' `seq` lastStep {
-                                   pstepReverseBackpropagations =
-                                       (p, sol):(pstepReverseBackpropagations lastStep)
+                                     props' = entry:props in
+                                 entry `seq` props `seq` props' `seq` lastStep {
+                                   pstepReverseBackpropagations = props'
                                  })
 
 
@@ -549,9 +550,8 @@ processBackpropagationAdd source matches =
           Just sol ->
               do p <- parseMatch promotion source (matches!2)
                  seen <- promotionIsSeen p
-                 unless seen $ do
-                   addSeenPromotion p
-                   p `seq` sol `seq` addBackpropagatedPromotionToCurrentStep sol p)
+                 addSeenPromotion p
+                 p `seq` sol `seq` seen `seq` addBackpropagatedPromotionToCurrentStep sol p seen)
 
 -- | Process a line of the log file that indicates that a particular
 -- resolution was attempted.
@@ -688,11 +688,12 @@ extractProcessingSteps partialSteps =
                  Just step -> Successor step c forced
                  Nothing   -> Unprocessed sol c forced
 
-      findBackpropagation :: (Solution, Promotion) -> Backpropagation
-      findBackpropagation (sol, p) =
+      findBackpropagation :: (Solution, Promotion, Bool) -> Backpropagation
+      findBackpropagation (sol, p, redundant) =
           case Map.lookup sol stepMap of
             Just step -> p `seq` Backpropagation { backpropagationStep = step,
-                                                   backpropagationPromotion = p }
+                                                   backpropagationPromotion = p,
+                                                   backpropagationRedundant = redundant }
             Nothing -> error $ "No match for the solution " ++ show sol ++ " when adding the backpropagated promotion " ++ show p
 
       -- How to build an output step from an input step.  This is
-- 
cgit v1.2.3