never executed always true always false

    1 {- |
    2 Module      : NITTA.Synthesis.Analysis
    3 Description : Analysis synthesis proccess.
    4 Copyright   : (c) Daniil Prohorov, 2021
    5 License     : BSD3
    6 Maintainer  : aleksandr.penskoi@gmail.com
    7 Stability   : experimental
    8 -}
    9 module NITTA.Synthesis.Analysis (
   10     getTreeInfo,
   11     TreeInfo (..),
   12 ) where
   13 
   14 import Control.Concurrent.STM
   15 import Data.HashMap.Strict qualified as HM
   16 import Data.Maybe (isJust)
   17 import GHC.Generics
   18 import NITTA.Model.ProcessorUnits.Types (NextTick)
   19 import NITTA.Model.TargetSystem (TargetSystem, processDuration)
   20 import NITTA.Model.Time (VarValTime)
   21 import NITTA.Synthesis.Types
   22 
   23 -- | Metrics of synthesis tree process
   24 data TreeInfo = TreeInfo
   25     { nodesVisited :: !Int
   26     , nodesSuccess :: !Int
   27     , nodesFailed :: !Int
   28     , nodesNotProcessed :: !Int
   29     , targetProcessDuration :: HM.HashMap Int Int
   30     , synthesisStepsForSuccess :: HM.HashMap Int Int
   31     }
   32     deriving (Generic, Show)
   33 
   34 instance Semigroup TreeInfo where
   35     a <> b =
   36         let ab = [a, b]
   37             durationSuccessList = map targetProcessDuration ab
   38             stepsSuccessList = map synthesisStepsForSuccess ab
   39          in TreeInfo
   40                 { nodesVisited = sum $ map nodesVisited ab
   41                 , nodesSuccess = sum $ map nodesSuccess ab
   42                 , nodesFailed = sum $ map nodesFailed ab
   43                 , nodesNotProcessed = sum $ map nodesNotProcessed ab
   44                 , targetProcessDuration = if not $ null durationSuccessList then foldr1 (HM.unionWith (+)) durationSuccessList else HM.empty
   45                 , synthesisStepsForSuccess = if not $ null stepsSuccessList then foldr1 (HM.unionWith (+)) stepsSuccessList else HM.empty
   46                 }
   47 
   48 instance Monoid TreeInfo where
   49     mempty =
   50         TreeInfo
   51             { nodesVisited = 0
   52             , nodesSuccess = 0
   53             , nodesFailed = 0
   54             , nodesNotProcessed = 0
   55             , targetProcessDuration = HM.empty
   56             , synthesisStepsForSuccess = HM.empty
   57             }
   58 
   59 getTreeInfo ::
   60     (VarValTime v x t, NextTick u t) =>
   61     Tree (TargetSystem u tag v x t) tag v x t ->
   62     IO TreeInfo
   63 getTreeInfo tree@Tree{sID = Sid sid, sSubForestVar} = do
   64     subForestM <- atomically $ tryReadTMVar sSubForestVar
   65     let isProcessed = isJust subForestM
   66     TreeInfo
   67         { nodesVisited
   68         , nodesSuccess
   69         , nodesFailed
   70         , targetProcessDuration
   71         , synthesisStepsForSuccess
   72         , nodesNotProcessed
   73         } <-
   74         maybe (return mempty) (fmap mconcat . mapM getTreeInfo) subForestM
   75 
   76     let (isSuccess, isFail)
   77             | isLeaf tree = if isComplete tree then (True, False) else (False, True)
   78             | otherwise = (False, False)
   79 
   80     let duration = fromEnum $ processDuration $ sTarget $ sState tree
   81 
   82     let registerIfSuccess stat value
   83             | not isSuccess = stat
   84             | otherwise = HM.alter (Just . maybe 1 (+ 1)) value stat
   85 
   86     return $
   87         TreeInfo
   88             { nodesVisited = nodesVisited + 1
   89             , nodesSuccess = nodesSuccess + if isSuccess then 1 else 0
   90             , nodesFailed = nodesFailed + if isFail then 1 else 0
   91             , nodesNotProcessed = nodesNotProcessed + if isProcessed then 0 else 1
   92             , targetProcessDuration = registerIfSuccess targetProcessDuration duration
   93             , synthesisStepsForSuccess = registerIfSuccess synthesisStepsForSuccess $ length sid
   94             }