summaryrefslogtreecommitdiff
path: root/tools/resolver-visualize/Resolver/Log.hs
diff options
context:
space:
mode:
Diffstat (limited to 'tools/resolver-visualize/Resolver/Log.hs')
-rw-r--r--tools/resolver-visualize/Resolver/Log.hs37
1 files changed, 19 insertions, 18 deletions
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