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