diff options
Diffstat (limited to 'tools/resolver-visualize')
| -rw-r--r-- | tools/resolver-visualize/DotRender.hs | 4 | ||||
| -rw-r--r-- | 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 |