never executed always true always false
1 {- |
2 Module : NITTA.Utils.ProcessDescription
3 Description : Utilities for process description.
4 Copyright : (c) Aleksandr Penskoi, 2019
5 License : BSD3
6 Maintainer : aleksandr.penskoi@gmail.com
7 Stability : experimental
8
9 A multilevel process is an object with a complex internal structure. Process description should
10 contain every step (including start and finish time), and relations between them (Vertical or
11 sequence). It is possible to define process manually, but, in practice, is preferred to use 'State'
12 based builder from that module.
13
14 It also agreed to the process inspection.
15 -}
16 module NITTA.Utils.ProcessDescription (
17 runSchedule,
18 execSchedule,
19 execScheduleWithProcess,
20 scheduleStep,
21 scheduleEndpoint,
22 scheduleEndpoint_,
23 scheduleFunctionBind,
24 scheduleFunctionRevoke,
25 scheduleFunction,
26 scheduleFunctionFinish,
27 scheduleFunctionFinish_,
28 scheduleRefactoring,
29 scheduleInstructionUnsafe,
30 scheduleInstructionUnsafe_,
31 scheduleNestedStep,
32 establishVerticalRelations,
33 establishHorizontalRelations,
34 getProcessSlice,
35 relatedEndpoints,
36 castInstruction,
37 scheduleAllocation,
38 ) where
39
40 import Control.Monad.State
41 import Data.Proxy (asProxyTypeOf)
42 import Data.Set qualified as S
43 import Data.Typeable
44 import NITTA.Intermediate.Types
45 import NITTA.Model.Problems
46 import NITTA.Model.ProcessorUnits.Types
47 import Numeric.Interval.NonEmpty (singleton, sup)
48
49 -- | Process builder state.
50 data Schedule pu v x t = Schedule
51 { schProcess :: Process t (StepInfo v x t)
52 -- ^ Defining process.
53 , iProxy :: Proxy (Instruction pu)
54 {- ^ Proxy for process unit instruction, which is needed for API simplify. Without that,
55 for some function, the user needs to describe type explicitly.
56 -}
57 }
58
59 instance {-# OVERLAPS #-} NextTick (Schedule pu v x t) t where
60 nextTick = nextTick . schProcess
61
62 {- | Execute process builder and return new process description. The initial process state is getting
63 from the PU by the 'process' function.
64 -}
65 execSchedule pu st = snd $ runSchedule pu st
66
67 {- | Execute process builder and return new process description. The initial
68 process state is passed explicetly.
69
70 Why can not we get a process here? In the case of Bus Network, it also fetches
71 processes from underlying units.
72 -}
73 execScheduleWithProcess pu p st = snd $ runScheduleWithProcess pu p st
74
75 {- | Execute process builder and return list of new step UID and new process description. The initial
76 process state is getting from the PU by the 'process' function.
77 -}
78 runSchedule pu st = runScheduleWithProcess pu (process pu) st
79
80 {- | Execute process builder and return list of new step UID and new process description. The initial
81 process state is passed explicetly.
82 -}
83 runScheduleWithProcess pu p st =
84 let (a, s) =
85 runState
86 st
87 Schedule
88 { schProcess = p
89 , iProxy = ip pu
90 }
91 in (a, schProcess s)
92 where
93 ip :: pu -> Proxy (Instruction pu)
94 ip _ = Proxy
95
96 -- | Add process step with passed the time and info.
97 scheduleStep placeInTime stepInfo =
98 scheduleStep' (\uid -> Step uid placeInTime stepInfo)
99
100 scheduleStep' mkStep = do
101 sch@Schedule{schProcess = p@Process{nextUid, steps}} <- get
102 put
103 sch
104 { schProcess =
105 p
106 { nextUid = succ nextUid
107 , steps = mkStep nextUid : steps
108 }
109 }
110 return [nextUid]
111
112 {- | Add to the process description information about vertical relations, which are defined by the
113 Cartesian product of high and low lists.
114 -}
115 establishVerticalRelations high low = do
116 sch@Schedule{schProcess = p@Process{relations}} <- get
117 put
118 sch
119 { schProcess =
120 p
121 { relations = [Vertical h l | h <- high, l <- low] ++ relations
122 }
123 }
124
125 {- | Add to the process description information about horizontal relations (inside
126 level), which are defined by the Cartesian product of high and low lists.
127 -}
128 establishHorizontalRelations high low = do
129 sch@Schedule{schProcess = p@Process{relations}} <- get
130 put
131 sch
132 { schProcess =
133 p
134 { relations = [Horizontal h l | h <- high, l <- low] ++ relations
135 }
136 }
137
138 scheduleFunctionBind f = do
139 schedule <- get
140 scheduleStep (singleton $ nextTick schedule) $ CADStep $ "bind " <> show f
141
142 scheduleFunctionRevoke f = do
143 schedule <- get
144 scheduleStep (singleton $ nextTick schedule) $ CADStep $ "revoke " <> show f
145
146 scheduleAllocation alloc = do
147 schedule <- get
148 scheduleStep (singleton $ nextTick schedule) $ AllocationStep alloc
149
150 -- | Add to the process description information about function evaluation.
151 scheduleFunction ti f = scheduleStep ti $ IntermediateStep f
152
153 scheduleRefactoring ti ref = scheduleStep ti $ RefactorStep ref
154
155 {- | Schedule function and establish vertical relations between bind step,
156 function step, and all related endpoints.
157 -}
158 scheduleFunctionFinish bPID function at = do
159 fPID <- scheduleFunction at function
160 establishVerticalRelations bPID fPID
161 process_ <- getProcessSlice
162 let low = map pID $ relatedEndpoints process_ $ variables function
163 establishVerticalRelations fPID low
164 return fPID
165
166 scheduleFunctionFinish_ bPID function at = void $ scheduleFunctionFinish bPID function at
167
168 {- | Add to the process description information about endpoint behaviour, and it's low-level
169 implementation (on instruction level). Vertical relations connect endpoint level and instruction
170 level steps.
171 -}
172 scheduleEndpoint EndpointSt{epAt, epRole} codeGen = do
173 high <- scheduleStep epAt $ EndpointRoleStep epRole
174 low <- codeGen
175 establishVerticalRelations high low
176 return high
177
178 scheduleEndpoint_ ep codeGen = void $ scheduleEndpoint ep codeGen
179
180 {- | Add to the process description information about instruction evaluation.
181 Unsafe means: without instruction collision check and nextTick consistency.
182 -}
183 scheduleInstructionUnsafe at instr = do
184 Schedule{iProxy} <- get
185 buf <- scheduleStep at $ InstructionStep (instr `asProxyTypeOf` iProxy)
186 updateTick $ sup at + 1
187 return buf
188 where
189 updateTick tick = do
190 sch@Schedule{schProcess} <- get
191 put
192 sch
193 { schProcess =
194 schProcess
195 { nextTick_ = tick
196 }
197 }
198
199 scheduleInstructionUnsafe_ ti instr = void $ scheduleInstructionUnsafe ti instr
200
201 -- | Add to the process description information about nested step.
202 scheduleNestedStep tag step@Step{pInterval} = do
203 pID <- scheduleStep' (\uid -> Step uid pInterval $ NestedStep tag step)
204 when (length pID /= 1) $ error "scheduleNestedStep internal error."
205 return $ head pID
206
207 -- | Get a current slice of the computational process.
208 getProcessSlice :: State (Schedule pu v x t) (Process t (StepInfo v x t))
209 getProcessSlice = do
210 Schedule{schProcess} <- get
211 return schProcess
212
213 relatedEndpoints process_ vs =
214 filter
215 ( \case
216 Step{pDesc = EndpointRoleStep role} -> not $ null (variables role `S.intersection` vs)
217 _ -> False
218 )
219 $ steps process_
220
221 -- | Helper for instruction extraction from a rigid type variable.
222 castInstruction :: (Typeable a, Typeable pu) => pu -> a -> Maybe (Instruction pu)
223 castInstruction _pu inst = cast inst