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     , dfTargets :: [(tag, EndpointSt v tp)]
   37     -- ^ All possible targets of dataflow transaction.
   38     }
   39     deriving (Generic)
   40 
   41 instance (ToString tag, Show (EndpointSt v tp)) => Show (DataflowSt tag v tp) where
   42     show DataflowSt{dfSource, dfTargets} =
   43         "DataflowSt{ dfSource=" <> show' dfSource <> ", dfTargets=" <> show (map show' dfTargets) <> "}"
   44         where
   45             show' (tag, ep) = "(" <> toString tag <> ", " <> show ep <> ")"
   46 
   47 instance Ord v => Variables (DataflowSt tag v tp) v where
   48     variables DataflowSt{dfTargets} = unionsMap (variables . snd) dfTargets
   49 
   50 {- | Implemented for any things, which can send data between processor units over
   51 the network.
   52 -}
   53 class DataflowProblem u tag v t | u -> tag v t where
   54     dataflowOptions :: u -> [DataflowSt tag v (TimeConstraint t)]
   55     dataflowDecision :: u -> DataflowSt tag v (Interval t) -> u
   56 
   57 -- | Convert dataflow option to decision.
   58 dataflowOption2decision :: Time t => DataflowSt tag v (TimeConstraint t) -> DataflowSt tag v (Interval t)
   59 dataflowOption2decision (DataflowSt (srcTag, srcEp) trgs) =
   60     let targetsAt = map (epAt . snd) trgs
   61 
   62         srcStart = maximum $ map (inf . tcAvailable) $ epAt srcEp : targetsAt
   63         srcDuration = maximum $ map (inf . tcDuration) $ epAt srcEp : targetsAt
   64         srcEnd = srcStart + srcDuration - 1
   65      in DataflowSt
   66             { dfSource = (srcTag, setAt (srcStart ... srcEnd) srcEp)
   67             , dfTargets = map (second (updAt (\tc -> srcStart ... (srcStart + inf (tcDuration tc) - 1)))) trgs
   68             }