From 7f84ae4152e4fc5de900ca583da9771c1fc42275 Mon Sep 17 00:00:00 2001 From: Daniel Burrows Date: Sun, 5 Apr 2009 08:21:45 -0700 Subject: Record which promotions have been previously seen in the current run, and only attach new promotions to output steps. To do this, I had to split the runs during the parse rather than in a post-processing step; otherwise the seen-promotions set would have carried over. (I could have just reset a few state variables, but this is cleaner anyway) Ideally I would actually track whether a promotion was redundant and only show non-redundant ones, but that takes a lot more code. --- tools/resolver-visualize/Resolver/Log.hs | 95 ++++++++++++++++++++++---------- 1 file changed, 66 insertions(+), 29 deletions(-) (limited to 'tools') diff --git a/tools/resolver-visualize/Resolver/Log.hs b/tools/resolver-visualize/Resolver/Log.hs index a709258b..56bc3b7c 100644 --- a/tools/resolver-visualize/Resolver/Log.hs +++ b/tools/resolver-visualize/Resolver/Log.hs @@ -193,10 +193,13 @@ data LogParseState = LogParseState { -- contains intern sets that should be shared over all parse -- steps. logParseParseState :: !ParseState, - -- | All the steps in the file, in reverse order. The first - -- element in this list is the step currently being parsed (if - -- any). + -- | All the steps in the current run, in reverse order. The + -- first element in this list is the step currently being parsed + -- (if any). logParseAllStepsReversed :: ![PartialStep], + -- | All the runs in the file, in reverse order (but the runs + -- are individually in order). + logParseAllRunsReversed :: ![[PartialStep]], -- | The name of the file being parsed. Read-only. logParseSourceName :: !String, -- | The current line. @@ -207,6 +210,11 @@ data LogParseState = LogParseState { -- generating successors for the dependency dep; otherwise -- Nothing. logParseGeneratingSuccessorsInfo :: !(Maybe GeneratingSuccessorsInfo), + -- | All the promotions that have been seen so far. + -- + -- Used to ensure that only new promotions are included in the + -- promotions of a particular step. + logParseSeenPromotions :: Set.Set Promotion, -- | The last seen line indicating the resolver is examining a -- choice. -- @@ -218,10 +226,12 @@ data LogParseState = LogParseState { initialState sourceName = LogParseState { logParseParseState = initialParseState, logParseAllStepsReversed = [], + logParseAllRunsReversed = [], logParseSourceName = sourceName, logParseCurrentLine = 0, logParseCurrentLineStart = 0, logParseGeneratingSuccessorsInfo = Nothing, + logParseSeenPromotions = Set.empty, logParseLastSeenTryChoice = Unknown } -- | The log parsing state monad. @@ -235,6 +245,28 @@ put :: LogParseState -> LogParse () put st = st `seq` do ref <- ask liftIO $ writeIORef ref st +-- | Reset the parts of the state dealing with the current run and +-- insert the run into the list. +-- +-- The argument is the file location that will be the "end" of the +-- run. +startNewRun :: Integer -> LogParse () +startNewRun loc = + do modifyLastStep (\lastStep -> lastStep { pstepTextLength = Just (loc - pstepTextStart lastStep) }) + st <- get + let stepsRev = logParseAllStepsReversed st + steps = reverse stepsRev + runsRev = logParseAllRunsReversed st + runsRev' = if null stepsRev then runsRev + else steps `seq` steps:runsRev + st' = runsRev' `seq` + st { logParseAllStepsReversed = [], + logParseAllRunsReversed = runsRev', + logParseGeneratingSuccessorsInfo = Nothing, + logParseSeenPromotions = Set.empty, + logParseLastSeenTryChoice = Unknown } + put st' + -- | Run a parser using the embedded state. parse p sourceName source = do st <- get @@ -266,6 +298,10 @@ setAllStepsReversed steps = steps `seq` do st <- get put $ st { logParseAllStepsReversed = steps } +getAllRunsReversed :: LogParse [[PartialStep]] +getAllRunsReversed = do st <- get + return $ logParseAllRunsReversed st + getSourceName :: LogParse String getSourceName = get >>= return . logParseSourceName @@ -286,6 +322,18 @@ setCurrentLineStart n = n `seq` do st <- get getGeneratingSuccessorsInfo :: LogParse (Maybe GeneratingSuccessorsInfo) getGeneratingSuccessorsInfo = get >>= return . logParseGeneratingSuccessorsInfo +promotionIsSeen :: Promotion -> LogParse Bool +promotionIsSeen p = do st <- get + return $ Set.member p (logParseSeenPromotions st) + +addSeenPromotion :: Promotion -> LogParse () +addSeenPromotion p = do st <- get + let seenPromotions = logParseSeenPromotions st + seenPromotions' = Set.insert p seenPromotions + st' = st { logParseSeenPromotions = seenPromotions' } + (p `seq` seenPromotions' `seq` + put st') + -- | Not strict in the contents of the Maybe. setGeneratingSuccessorsInfo :: Maybe GeneratingSuccessorsInfo -> LogParse () setGeneratingSuccessorsInfo inf = @@ -389,6 +437,9 @@ addSuccessor succInf@(s, _, _) filename lineNum lastStep = processStepStartLine :: ByteString -> MatchArray -> LogParse () processStepStartLine source matches = do sol <- parseMatch solution source (matches!1) + loc <- getCurrentLineStart + -- If the solution is empty, assume we're starting a new run. + when (Map.null $ solChoices sol) (startNewRun loc) startNewStep sol -- | Process a line of the log file if it looks like it produced a new @@ -396,11 +447,14 @@ processStepStartLine source matches = processNewPromotionLine :: ByteString -> MatchArray -> LogParse () processNewPromotionLine source matches = do p <- parseMatch promotion source (matches!1) - -- Add the promotion to the current step. - p `seq` modifyLastStep (\lastStep -> - let oldPromotions = pstepPromotions lastStep - newPromotions = (p:oldPromotions) in - lastStep { pstepPromotions = newPromotions }) + seen <- promotionIsSeen p + unless seen $ do + addSeenPromotion p + -- Add the promotion to the current step. + p `seq` modifyLastStep (\lastStep -> + let oldPromotions = pstepPromotions lastStep + newPromotions = (p:oldPromotions) in + lastStep { pstepPromotions = newPromotions }) -- | Process a line of the log file that starts successor generation. processSuccessorsStartLine :: ByteString -> MatchArray -> LogParse () @@ -518,22 +572,6 @@ extractPredecessorLinks (step:steps) = | (childSolution, childChoice, _) <- pstepReverseSuccessors step] ++ extractPredecessorLinks steps --- | Take a list of partial steps and split it up into distinct runs --- of the resolver. -splitRuns :: [PartialStep] -> [[PartialStep]] -splitRuns steps = doSplitRuns steps [] - where doSplitRuns [] rval = reverse (map reverse rval) - doSplitRuns (first:rest) rval = - -- Solutions with no choices are assumed to start a run - -- of the resolver. - let rval' = if Map.null (solChoices $ pstepSol first) - then ([first]:rval) - else case rval of - [] -> [[first]] - (first':rest') -> (first:first'):rest' - in - rval' `seq` doSplitRuns rest rval' - -- | Map a list of partial processing steps (in order) to a collection -- of processing steps. extractProcessingSteps :: [PartialStep] -> [ProcessingStep] @@ -588,7 +626,7 @@ extractProcessingSteps partialSteps = start = pstepTextStart pstep len = case pstepTextLength pstep of Just len -> len - Nothing -> error "Internal error: missing text length." + Nothing -> error $ "Internal error: missing text length in step " ++ (show n) ++ "." in sol `seq` n `seq` depth `seq` branchSize `seq` promotions `seq` start `seq` len `seq` ProcessingStep { stepPredecessor = Map.lookup sol parentMap, @@ -652,10 +690,9 @@ processFile h progress = -- The last step won't have a length because we update it when -- we add a new step; fix that. loc <- liftIO $ hTell h - modifyLastStep (\lastStep -> lastStep { pstepTextLength = Just (loc - pstepTextStart lastStep) }) - stepsReversed <- getAllStepsReversed - let steps = reverse stepsReversed - runs = splitRuns steps + startNewRun loc -- Force the current run onto the runs list. + runsReversed <- getAllRunsReversed + let runs = reverse runsReversed outRuns = map extractProcessingSteps runs (map seqList outRuns) `seqList` return $ LogFile h sourceName outRuns -- cgit v1.2.3