never executed always true always false

    1 {-# LANGUAGE ConstraintKinds #-}
    2 {-# LANGUAGE FunctionalDependencies #-}
    3 {-# LANGUAGE GADTs #-}
    4 
    5 {- |
    6 Module      : NITTA.Model.Problems.Dataflow
    7 Description : Sending data between processor units over a network
    8 Copyright   : (c) Aleksandr Penskoi, 2019
    9 License     : BSD3
   10 Maintainer  : aleksandr.penskoi@gmail.com
   11 Stability   : experimental
   12 -}
   13 module NITTA.Model.Problems.Dataflow (
   14     DataflowSt (..),
   15     DataflowProblem (..),
   16     dataflowOption2decision,
   17 ) where
   18 
   19 import Data.Bifunctor
   20 import Data.String.ToString
   21 import GHC.Generics
   22 import NITTA.Intermediate.Variable
   23 import NITTA.Model.Problems.Endpoint
   24 import NITTA.Model.Time
   25 import NITTA.Utils.Base
   26 import Numeric.Interval.NonEmpty
   27 
   28 {- | Dataflow option (@tp ~ TimeConstraint t@) or decision (@tp Z Interval t@)
   29 statement. Describe sending data between processor units over a network. Any
   30 'DataflowSt' has implicently linked "NITTA.Model.Problems.Endpoint".
   31 -}
   32 data DataflowSt tag v tp = DataflowSt
   33     { dfSource :: (tag, EndpointSt v tp)
   34     {- ^ A source processor unit of data flow transaction, and it's time
   35     constrains which defines when data can be sended.
   36     -}
   37     , dfTargets :: [(tag, EndpointSt v tp)]
   38     -- ^ All possible targets of dataflow transaction.
   39     }
   40     deriving (Generic)
   41 
   42 instance (ToString tag, Show (EndpointSt v tp)) => Show (DataflowSt tag v tp) where
   43     show DataflowSt{dfSource, dfTargets} =
   44         "DataflowSt{ dfSource=" <> show' dfSource <> ", dfTargets=" <> show (map show' dfTargets) <> "}"
   45         where
   46             show' (tag, ep) = "(" <> toString tag <> ", " <> show ep <> ")"
   47 
   48 instance Ord v => Variables (DataflowSt tag v tp) v where
   49     variables DataflowSt{dfTargets} = unionsMap (variables . snd) dfTargets
   50 
   51 {- | Implemented for any things, which can send data between processor units over
   52 the network.
   53 -}
   54 class DataflowProblem u tag v t | u -> tag v t where
   55     dataflowOptions :: u -> [DataflowSt tag v (TimeConstraint t)]
   56     dataflowDecision :: u -> DataflowSt tag v (Interval t) -> u
   57 
   58 -- | Convert dataflow option to decision.
   59 dataflowOption2decision :: Time t => DataflowSt tag v (TimeConstraint t) -> DataflowSt tag v (Interval t)
   60 dataflowOption2decision (DataflowSt (srcTag, srcEp) trgs) =
   61     let targetsAt = map (epAt . snd) trgs
   62 
   63         srcStart = maximum $ map (inf . tcAvailable) $ epAt srcEp : targetsAt
   64         srcDuration = maximum $ map (inf . tcDuration) $ epAt srcEp : targetsAt
   65         srcEnd = srcStart + srcDuration - 1
   66      in DataflowSt
   67             { dfSource = (srcTag, setAt (srcStart ... srcEnd) srcEp)
   68             , dfTargets = map (second (updAt (\tc -> srcStart ... (srcStart + inf (tcDuration tc) - 1)))) trgs
   69             }