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.Bind
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.Bind (
15 BindMetrics (..),
16 isSingleBind,
17 isMultiBind,
18 isObviousMultiBind,
19 ) where
20
21 import Data.Aeson (ToJSON)
22 import Data.List qualified as L
23 import Data.Map.Strict qualified as M
24 import Data.Maybe
25 import Data.Set qualified as S
26 import Data.Typeable
27 import GHC.Generics
28 import NITTA.Intermediate.Types
29 import NITTA.Model.Networks.Bus
30 import NITTA.Model.Problems.Bind
31 import NITTA.Model.Problems.Dataflow
32 import NITTA.Model.Problems.Endpoint
33 import NITTA.Model.ProcessorUnits
34 import NITTA.Model.TargetSystem
35 import NITTA.Synthesis.Types
36 import NITTA.Utils
37 import Numeric.Interval.NonEmpty (inf)
38
39 data BindMetrics
40 = SingleBindMetrics
41 { pCritical :: Bool
42 {- ^ Can this binding block another one (for example, one 'Loop' can
43 take the last free buffer)?
44 -}
45 , pAlternative :: Float
46 -- ^ How many alternative binding we have?
47 , pRestless :: Float
48 -- ^ How many ticks requires for executing the function?
49 , pOutputNumber :: Float
50 , pAllowDataFlow :: Float
51 -- ^ How many transactions can be executed with this function?
52 , pPossibleDeadlock :: Bool
53 -- ^ May this binding cause deadlock?
54 , pNumberOfBoundFunctions :: Float
55 , pPercentOfBoundInputs :: Float
56 -- ^ number of bound input variables / number of all input variables
57 , pWave :: Maybe Float
58 }
59 | GroupBindMetrics
60 { pOnlyObviousBinds :: Bool
61 -- ^ We don't have alternatives for binding
62 , pFunctionPercentInBinds :: Float
63 -- ^ number of bound functions / number of all functions in DFG
64 , pAvgBinds :: Float
65 -- ^ average number of binds per unit
66 , pVarianceBinds :: Float
67 -- ^ variance of binds per unit
68 , pAvgUnitWorkload :: Float
69 -- ^ average number of variables after bind per unit
70 , pVarianceUnitWorkload :: Float
71 -- ^ variance of variables after bind per unit
72 }
73 deriving (Generic)
74
75 instance ToJSON BindMetrics
76
77 instance
78 (UnitTag tag, VarValTime v x t) =>
79 SynthesisDecisionCls
80 (SynthesisState (TargetSystem (BusNetwork tag v x t) tag v x t) tag v x t)
81 (TargetSystem (BusNetwork tag v x t) tag v x t)
82 (Bind tag v x)
83 (Bind tag v x)
84 BindMetrics
85 where
86 decisions SynthesisState{sTarget} o = [(o, bindDecision sTarget o)]
87
88 parameters
89 SynthesisState
90 { bindingAlternative
91 , sTarget = sTarget@TargetSystem{mUnit}
92 , possibleDeadlockBinds
93 , bindWaves
94 }
95 (SingleBind tag f)
96 _ =
97 SingleBindMetrics
98 { pCritical = isInternalLockPossible f
99 , pAlternative = fromIntegral $ length (bindingAlternative M.! f)
100 , pAllowDataFlow = fromIntegral $ length $ unionsMap variables $ filter isTarget $ optionsAfterBind f tag sTarget
101 , pRestless = fromMaybe 0 $ do
102 (_var, tcFrom) <- L.find (\(v, _) -> v `elem` variables f) $ waitingTimeOfVariables sTarget
103 return $ fromIntegral tcFrom
104 , pOutputNumber = fromIntegral $ length $ S.elems $ outputs f
105 , pPossibleDeadlock = f `S.member` possibleDeadlockBinds
106 , pNumberOfBoundFunctions = fromIntegral $ length $ boundFunctions tag mUnit
107 , pPercentOfBoundInputs =
108 let is = inputs f
109 n = fromIntegral $ length $ S.intersection is $ variables mUnit
110 nAll = fromIntegral $ length is
111 in if nAll == 0 then 1 else n / nAll
112 , pWave = fmap fromIntegral $ case map (bindWaves M.!?) $ S.elems $ inputs f of
113 [] -> Just 0
114 waves | all isJust waves -> Just $ maximum $ catMaybes waves
115 _ -> Nothing
116 }
117 parameters SynthesisState{sTarget, unitWorkloadInFunction} binds@GroupBind{isObviousBinds, bindGroup} _ =
118 let dfgFunCount = length $ functions $ mDataFlowGraph sTarget
119 bindFunCount = length $ functions binds
120 in GroupBindMetrics
121 { pOnlyObviousBinds = isObviousBinds
122 , pFunctionPercentInBinds = fromIntegral bindFunCount / fromIntegral dfgFunCount
123 , pAvgBinds = avg $ map (fromIntegral . length . snd) $ M.assocs bindGroup
124 , pVarianceBinds = stddev $ map (fromIntegral . length . snd) $ M.assocs bindGroup
125 , pAvgUnitWorkload = avg $ map unitWorkload $ M.keys bindGroup
126 , pVarianceUnitWorkload = stddev $ map unitWorkload $ M.keys bindGroup
127 }
128 where
129 unitWorkload = fromIntegral . (unitWorkloadInFunction M.!)
130 avg lst = sum lst / fromIntegral (length lst)
131 stddev lst =
132 let lstAvg = avg lst
133 in sqrt $ avg $ map (\x -> (x - lstAvg) ^ (2 :: Int)) lst
134
135 estimate _ctx _o _d GroupBindMetrics{pOnlyObviousBinds, pFunctionPercentInBinds, pVarianceBinds} =
136 sum
137 [ 4100
138 , pOnlyObviousBinds <?> 1000
139 , fromInteger $ round pFunctionPercentInBinds * 10
140 , fromInteger $ round pVarianceBinds * (-20)
141 ]
142 estimate _ctx _o _d SingleBindMetrics{pPossibleDeadlock = True} = 500
143 estimate
144 _ctx
145 _o
146 _d
147 SingleBindMetrics
148 { pCritical
149 , pAlternative
150 , pAllowDataFlow
151 , pRestless
152 , pNumberOfBoundFunctions
153 , pWave
154 , pPercentOfBoundInputs
155 , pOutputNumber
156 } =
157 sum
158 [ 3000
159 , pCritical <?> 1000
160 , (pAlternative == 1) <?> 500
161 , pAllowDataFlow * 10
162 , pPercentOfBoundInputs * 50
163 , -fromMaybe (-1) pWave * 50
164 , -pNumberOfBoundFunctions * 10
165 , -pRestless * 4
166 , pOutputNumber * 2
167 ]
168
169 waitingTimeOfVariables net =
170 [ (variable, inf $ tcAvailable constrain)
171 | DataflowSt{dfSource = (_, srcEp), dfTargets} <- dataflowOptions net
172 , let constrain = epAt srcEp
173 , variable <- S.elems (variables srcEp S.\\ unionsMap (variables . snd) dfTargets)
174 ]
175
176 optionsAfterBind f tag TargetSystem{mUnit = BusNetwork{bnPus}} =
177 case tryBind f (bnPus M.! tag) of
178 Right pu' -> filter (\(EndpointSt act _) -> act `optionOf` f) $ endpointOptions pu'
179 _ -> []
180 where
181 act `optionOf` f' = not $ S.null (variables act `S.intersection` variables f')
182
183 isSingleBind :: SynthesisDecision ctx m -> Bool
184 isSingleBind SynthesisDecision{metrics}
185 | Just SingleBindMetrics{} <- cast metrics :: Maybe BindMetrics = True
186 isSingleBind _ = False
187
188 isMultiBind :: SynthesisDecision ctx m -> Bool
189 isMultiBind SynthesisDecision{metrics}
190 | Just GroupBindMetrics{} <- cast metrics :: Maybe BindMetrics = True
191 isMultiBind _ = False
192
193 isObviousMultiBind :: SynthesisDecision ctx m -> Bool
194 isObviousMultiBind SynthesisDecision{metrics}
195 | Just GroupBindMetrics{pOnlyObviousBinds = True} <- cast metrics :: Maybe BindMetrics = True
196 isObviousMultiBind _ = False