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