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