never executed always true always false
    1 {-# LANGUAGE GADTs #-}
    2 {-# LANGUAGE NoMonomorphismRestriction #-}
    3 
    4 {-# OPTIONS -fno-warn-orphans #-}
    5 
    6 {- |
    7 Module      : NITTA.Synthesis.Steps.Dataflow
    8 Description :
    9 Copyright   : (c) Aleksandr Penskoi, 2021
   10 License     : BSD3
   11 Maintainer  : aleksandr.penskoi@gmail.com
   12 Stability   : experimental
   13 -}
   14 module NITTA.Synthesis.Steps.Dataflow (
   15     DataflowMetrics (..),
   16 ) where
   17 
   18 import Data.Aeson (ToJSON)
   19 import Data.Set qualified as S
   20 import GHC.Generics (Generic)
   21 import NITTA.Intermediate.Analysis (ProcessWave (..))
   22 import NITTA.Intermediate.Types (
   23     Function (inputs),
   24     Variables (variables),
   25     WithFunctions (functions),
   26  )
   27 import NITTA.Model.Networks.Bus (BusNetwork)
   28 import NITTA.Model.Problems.Dataflow (
   29     DataflowProblem (dataflowDecision),
   30     DataflowSt (..),
   31     dataflowOption2decision,
   32  )
   33 import NITTA.Model.Problems.Endpoint (EndpointSt (epAt))
   34 import NITTA.Model.ProcessorUnits.Types (UnitTag)
   35 import NITTA.Model.TargetSystem (TargetSystem (mUnit))
   36 import NITTA.Model.Time (TimeConstraint (..), VarValTime)
   37 import NITTA.Synthesis.Types (
   38     SynthesisDecisionCls (..),
   39     SynthesisState (
   40         SynthesisState,
   41         numberOfDataflowOptions,
   42         processWaves,
   43         sTarget,
   44         transferableVars
   45     ),
   46     (<?>),
   47  )
   48 import NITTA.Utils.Base (unionsMap)
   49 import Numeric.Interval.NonEmpty (Interval, inf, sup)
   50 
   51 data DataflowMetrics = DataflowMetrics
   52     { pWaitTime :: Float
   53     , pRestrictedTime :: Bool
   54     , pNotTransferableInputs :: [Float]
   55     {- ^ number of variables, which is not transferable for affected
   56     functions.
   57     -}
   58     , pFirstWaveOfTargetUse :: Float
   59     -- ^ number of the first wave in which one of the target variables is used
   60     }
   61     deriving (Generic)
   62 
   63 instance ToJSON DataflowMetrics
   64 
   65 instance
   66     (UnitTag tag, VarValTime v x t) =>
   67     SynthesisDecisionCls
   68         (SynthesisState (TargetSystem (BusNetwork tag v x t) tag v x t) tag v x t)
   69         (TargetSystem (BusNetwork tag v x t) tag v x t)
   70         (DataflowSt tag v (TimeConstraint t))
   71         (DataflowSt tag v (Interval t))
   72         DataflowMetrics
   73     where
   74     decisions SynthesisState{sTarget} o = let d = dataflowOption2decision o in [(d, dataflowDecision sTarget d)]
   75 
   76     parameters SynthesisState{transferableVars, sTarget, processWaves} DataflowSt{dfSource, dfTargets} _ =
   77         let TimeConstraint{tcAvailable, tcDuration} = epAt $ snd dfSource
   78             vs = unionsMap (variables . snd) dfTargets
   79             lvs = length vs
   80             waveNum =
   81                 length
   82                     . takeWhile (\ProcessWave{pwFs} -> lvs == length (vs `S.difference` unionsMap inputs pwFs))
   83                     $ processWaves
   84          in DataflowMetrics
   85                 { pWaitTime = fromIntegral (inf tcAvailable)
   86                 , pRestrictedTime = fromEnum (sup tcDuration) /= maxBound
   87                 , pNotTransferableInputs =
   88                     let fs = functions $ mUnit sTarget
   89                         affectedFunctions = filter (\f -> not $ null (inputs f `S.intersection` vs)) fs
   90                         notTransferableVars = map (\f -> inputs f S.\\ transferableVars) affectedFunctions
   91                      in map (fromIntegral . length) notTransferableVars
   92                 , pFirstWaveOfTargetUse = fromIntegral waveNum :: Float
   93                 }
   94 
   95     estimate
   96         SynthesisState{numberOfDataflowOptions}
   97         _o
   98         _d
   99         DataflowMetrics
  100             { pWaitTime
  101             , pNotTransferableInputs
  102             , pRestrictedTime
  103             , pFirstWaveOfTargetUse
  104             } =
  105             sum
  106                 [ 2000
  107                 , (numberOfDataflowOptions >= threshold) <?> 1000
  108                 , pRestrictedTime <?> 200
  109                 , sum pNotTransferableInputs * (-5)
  110                 , -pWaitTime
  111                 , -pFirstWaveOfTargetUse
  112                 ]
  113 
  114 threshold = 20