never executed always true always false
1 {-# LANGUAGE AllowAmbiguousTypes #-}
2 {-# LANGUAGE DuplicateRecordFields #-}
3 {-# LANGUAGE GADTs #-}
4
5 {- |
6 Module : NITTA.Intermediate.Functions
7 Description : Library of functions
8 Copyright : (c) Aleksandr Penskoi, 2019
9 License : BSD3
10 Maintainer : aleksandr.penskoi@gmail.com
11 Stability : experimental
12
13 Library of functions for an intermediate algorithm representation. Execution
14 relations between functions and process units are many-to-many.
15
16 [@function (functional block)@] atomic operation in intermediate algorithm
17 representation. Function has zero or many inputs and zero or many output.
18 Function can contains state between process cycles.
19 -}
20 module NITTA.Intermediate.Functions (
21 -- * Arithmetics
22 Add (..),
23 add,
24 Division (..),
25 division,
26 Multiply (..),
27 multiply,
28 ShiftLR (..),
29 shiftL,
30 shiftR,
31 Sub (..),
32 sub,
33 Neg (..),
34 neg,
35 module NITTA.Intermediate.Functions.Accum,
36
37 -- * Memory
38 Constant (..),
39 constant,
40 isConst,
41 Loop (..),
42 loop,
43 isLoop,
44 LoopEnd (..),
45 LoopBegin (..),
46 Buffer (..),
47 buffer,
48
49 -- * Input/Output
50 Receive (..),
51 receive,
52 Send (..),
53 send,
54
55 -- * Internal
56 BrokenBuffer (..),
57 brokenBuffer,
58 ) where
59
60 import Data.Bits qualified as B
61 import Data.Default
62 import Data.HashMap.Strict qualified as HM
63 import Data.Set (elems, fromList, union)
64 import Data.Typeable
65 import NITTA.Intermediate.Functions.Accum
66 import NITTA.Intermediate.Types
67 import NITTA.Utils.Base
68
69 {- | Loop -- function for transfer data between computational cycles.
70 Let see the simple example with the following implementation of the
71 Fibonacci algorithm.
72
73 Data flow graph:
74
75 @
76 +---------------------------------+
77 | |
78 v |
79 +------+ b2 |
80 | Loop | b1_1 +-----+ +------+
81 +------+----+------>| | |
82 | a1 | sum +----+
83 +------+----------->| |
84 | Loop | | +-----+ b1_2
85 +------+ +-------------------------+
86 ^ |
87 | |
88 +---------------------------------+
89 @
90
91 Lua source code:
92
93 @
94 function fib(a1, b1)
95 b2 = a1 + b1
96 fib(b1, b2)
97 end
98 fib(0, 1)
99 @
100
101 Data flow defines computation for a single computational cycle. But
102 a controller should repeat the algorithm infinite times, and
103 usually, it is required to transfer data between cycles. `Loop`
104 allows doing that. At first cycle, `Loop` function produces an
105 initial value (`X x`), after that on each cycle `Loop` produces a
106 variable value from the previous cycle, and consumes a new value at
107 the end of the cycle.
108
109 Computational process:
110
111 @
112 ][ Cycle 1 ][ Cycle 2 ]
113 ][ ][ ]
114 initial ][ ---+ b2 +--- ][ ---+ b2 +--- ]
115 value ][ op | b1_1 +-----+ +------>| Lo ][ op | b1_1 +-----+ +------>| Lo ]
116 is a ][ ---+----+------>| | | +--- ][ ---+----+------>| | | +--- ]
117 part of ][ | | sum +----+ ][ | | sum +----+ ]
118 software ][ ---+----------->| | +--- ][ ---+----------->| | +--- ]
119 ][ op | | +-----+ b1_2 | Lo ][ op | | +-----+ b1_2 | Lo ]
120 ][ ---+ +------------------------->+--- ][ ---+ +------------------------->+--- ]
121 ][ ][ ]
122 @
123
124 Similation data:
125
126 +--------------+----+----+----+
127 | Cycle number | a1 | b1 | b2 |
128 +==============+====+====+====+
129 | 1 | 0 | 1 | 1 |
130 +--------------+----+----+----+
131 | 2 | 1 | 1 | 2 |
132 +--------------+----+----+----+
133 | 3 | 1 | 2 | 3 |
134 +--------------+----+----+----+
135 | 4 | 2 | 3 | 5 |
136 +--------------+----+----+----+
137
138 In practice, Loop function supported by Fram processor unit in the
139 following way: Loop function should be prepared before execution by
140 automatical refactor @BreakLoop@, which replace Loop by @LoopEnd@
141 and @LoopBegin@.
142 -}
143 data Loop v x = Loop (X x) (O v) (I v) deriving (Typeable, Eq)
144
145 instance (Var v, Show x) => Show (Loop v x) where show = label
146 instance (Var v, Show x) => Label (Loop v x) where
147 label (Loop (X x) os i) =
148 "loop(" <> show x <> ", " <> show i <> ") = " <> show os
149 loop :: (Var v, Val x) => x -> v -> [v] -> F v x
150 loop x a bs = packF $ Loop (X x) (O $ fromList bs) $ I a
151 isLoop f
152 | Just Loop{} <- castF f = True
153 | otherwise = False
154
155 instance Function (Loop v x) v where
156 isInternalLockPossible _ = True
157 inputs (Loop _ _a b) = variables b
158 outputs (Loop _ a _b) = variables a
159 instance Var v => Patch (Loop v x) (v, v) where
160 patch diff (Loop x a b) = Loop x (patch diff a) (patch diff b)
161 instance Var v => Locks (Loop v x) v where
162 locks (Loop _ (O as) (I b)) = [Lock{locked = b, lockBy = a} | a <- elems as]
163 instance Var v => FunctionSimulation (Loop v x) v x where
164 simulate CycleCntx{cycleCntx} (Loop (X x) (O vs) (I _)) =
165 case oneOf vs `HM.lookup` cycleCntx of
166 -- if output variables are defined - nothing to do (values thrown on upper level)
167 Just _ -> []
168 -- if output variables are not defined - set initial value
169 Nothing -> [(v, x) | v <- elems vs]
170
171 data LoopBegin v x = LoopBegin (Loop v x) (O v) deriving (Typeable, Eq)
172 instance (Var v, Show x) => Show (LoopBegin v x) where show = label
173 instance Var v => Label (LoopBegin v x) where
174 label (LoopBegin _ os) = "LoopBegin() = " <> show os
175 instance Var v => Function (LoopBegin v x) v where
176 outputs (LoopBegin _ o) = variables o
177 isInternalLockPossible _ = True
178 instance Var v => Patch (LoopBegin v x) (v, v) where
179 patch diff (LoopBegin l a) = LoopBegin (patch diff l) $ patch diff a
180 instance Var v => Locks (LoopBegin v x) v where
181 locks _ = []
182 instance Var v => FunctionSimulation (LoopBegin v x) v x where
183 simulate cntx (LoopBegin l _) = simulate cntx l
184
185 data LoopEnd v x = LoopEnd (Loop v x) (I v) deriving (Typeable, Eq)
186 instance (Var v, Show x) => Show (LoopEnd v x) where show = label
187 instance Var v => Label (LoopEnd v x) where
188 label (LoopEnd (Loop _ os _) i) = "LoopEnd(" <> show i <> ") pair out: " <> show os
189 instance Var v => Function (LoopEnd v x) v where
190 inputs (LoopEnd _ o) = variables o
191 isInternalLockPossible _ = True
192 instance Var v => Patch (LoopEnd v x) (v, v) where
193 patch diff (LoopEnd l a) = LoopEnd (patch diff l) $ patch diff a
194 instance Var v => Locks (LoopEnd v x) v where locks (LoopEnd l _) = locks l
195 instance Var v => FunctionSimulation (LoopEnd v x) v x where
196 simulate cntx (LoopEnd l _) = simulate cntx l
197
198 data Buffer v x = Buffer (I v) (O v) deriving (Typeable, Eq)
199 instance Label (Buffer v x) where label Buffer{} = "buf"
200 instance Var v => Show (Buffer v x) where
201 show (Buffer i os) = "buffer(" <> show i <> ")" <> " = " <> show os
202 buffer :: (Var v, Val x) => v -> [v] -> F v x
203 buffer a b = packF $ Buffer (I a) (O $ fromList b)
204
205 instance Var v => Function (Buffer v x) v where
206 inputs (Buffer a _b) = variables a
207 outputs (Buffer _a b) = variables b
208 instance Var v => Patch (Buffer v x) (v, v) where
209 patch diff (Buffer a b) = Buffer (patch diff a) (patch diff b)
210 instance Var v => Locks (Buffer v x) v where
211 locks = inputsLockOutputs
212 instance Var v => FunctionSimulation (Buffer v x) v x where
213 simulate cntx (Buffer (I a) (O vs)) =
214 [(v, cntx `getCntx` a) | v <- elems vs]
215
216 data Add v x = Add (I v) (I v) (O v) deriving (Typeable, Eq)
217 instance Label (Add v x) where label Add{} = "+"
218 instance Var v => Show (Add v x) where
219 show (Add a b c) =
220 let lexp = show a <> " + " <> show b
221 rexp = show c
222 in lexp <> " = " <> rexp
223 add :: (Var v, Val x) => v -> v -> [v] -> F v x
224 add a b c = packF $ Add (I a) (I b) $ O $ fromList c
225
226 instance Var v => Function (Add v x) v where
227 inputs (Add a b _c) = variables a `union` variables b
228 outputs (Add _a _b c) = variables c
229 instance Var v => Patch (Add v x) (v, v) where
230 patch diff (Add a b c) = Add (patch diff a) (patch diff b) (patch diff c)
231 instance Var v => Locks (Add v x) v where
232 locks = inputsLockOutputs
233 instance (Var v, Num x) => FunctionSimulation (Add v x) v x where
234 simulate cntx (Add (I v1) (I v2) (O vs)) =
235 let x1 = cntx `getCntx` v1
236 x2 = cntx `getCntx` v2
237 y = x1 + x2
238 in [(v, y) | v <- elems vs]
239
240 data Sub v x = Sub (I v) (I v) (O v) deriving (Typeable, Eq)
241 instance Label (Sub v x) where label Sub{} = "-"
242 instance Var v => Show (Sub v x) where
243 show (Sub a b c) =
244 let lexp = show a <> " - " <> show b
245 rexp = show c
246 in lexp <> " = " <> rexp
247 sub :: (Var v, Val x) => v -> v -> [v] -> F v x
248 sub a b c = packF $ Sub (I a) (I b) $ O $ fromList c
249
250 instance Var v => Function (Sub v x) v where
251 inputs (Sub a b _c) = variables a `union` variables b
252 outputs (Sub _a _b c) = variables c
253 instance Var v => Patch (Sub v x) (v, v) where
254 patch diff (Sub a b c) = Sub (patch diff a) (patch diff b) (patch diff c)
255 instance Var v => Locks (Sub v x) v where
256 locks = inputsLockOutputs
257 instance (Var v, Num x) => FunctionSimulation (Sub v x) v x where
258 simulate cntx (Sub (I v1) (I v2) (O vs)) =
259 let x1 = cntx `getCntx` v1
260 x2 = cntx `getCntx` v2
261 y = x1 - x2
262 in [(v, y) | v <- elems vs]
263
264 data Multiply v x = Multiply (I v) (I v) (O v) deriving (Typeable, Eq)
265 instance Label (Multiply v x) where label Multiply{} = "*"
266 instance Var v => Show (Multiply v x) where
267 show (Multiply a b c) =
268 show a <> " * " <> show b <> " = " <> show c
269 multiply :: (Var v, Val x) => v -> v -> [v] -> F v x
270 multiply a b c = packF $ Multiply (I a) (I b) $ O $ fromList c
271
272 instance Var v => Function (Multiply v x) v where
273 inputs (Multiply a b _c) = variables a `union` variables b
274 outputs (Multiply _a _b c) = variables c
275 instance Var v => Patch (Multiply v x) (v, v) where
276 patch diff (Multiply a b c) = Multiply (patch diff a) (patch diff b) (patch diff c)
277 instance Var v => Locks (Multiply v x) v where
278 locks = inputsLockOutputs
279 instance (Var v, Num x) => FunctionSimulation (Multiply v x) v x where
280 simulate cntx (Multiply (I v1) (I v2) (O vs)) =
281 let x1 = cntx `getCntx` v1
282 x2 = cntx `getCntx` v2
283 y = x1 * x2
284 in [(v, y) | v <- elems vs]
285
286 data Division v x = Division
287 { denom, numer :: I v
288 , quotient, remain :: O v
289 }
290 deriving (Typeable, Eq)
291 instance Label (Division v x) where label Division{} = "/"
292 instance Var v => Show (Division v x) where
293 show Division{denom, numer, quotient, remain} =
294 let q = show numer <> " / " <> show denom <> " = " <> show quotient
295 r = show numer <> " mod " <> show denom <> " = " <> show remain
296 in q <> "; " <> r
297 division :: (Var v, Val x) => v -> v -> [v] -> [v] -> F v x
298 division d n q r =
299 packF $
300 Division
301 { denom = I d
302 , numer = I n
303 , quotient = O $ fromList q
304 , remain = O $ fromList r
305 }
306
307 instance Var v => Function (Division v x) v where
308 inputs Division{denom, numer} = variables denom `union` variables numer
309 outputs Division{quotient, remain} = variables quotient `union` variables remain
310 instance Var v => Patch (Division v x) (v, v) where
311 patch diff (Division a b c d) = Division (patch diff a) (patch diff b) (patch diff c) (patch diff d)
312 instance Var v => Locks (Division v x) v where
313 locks = inputsLockOutputs
314 instance (Var v, Integral x) => FunctionSimulation (Division v x) v x where
315 simulate cntx Division{denom = I d, numer = I n, quotient = O qs, remain = O rs} =
316 let dx = cntx `getCntx` d
317 nx = cntx `getCntx` n
318 (qx, rx) = dx `quotRem` nx
319 in [(v, qx) | v <- elems qs] ++ [(v, rx) | v <- elems rs]
320
321 data Neg v x = Neg (I v) (O v) deriving (Typeable, Eq)
322 instance Label (Neg v x) where label Neg{} = "neg"
323 instance Var v => Show (Neg v x) where
324 show (Neg i o) = "-" <> show i <> " = " <> show o
325
326 neg :: (Var v, Val x) => v -> [v] -> F v x
327 neg i o = packF $ Neg (I i) $ O $ fromList o
328
329 instance Ord v => Function (Neg v x) v where
330 inputs (Neg i _) = variables i
331 outputs (Neg _ o) = variables o
332 instance Ord v => Patch (Neg v x) (v, v) where
333 patch diff (Neg i o) = Neg (patch diff i) (patch diff o)
334 instance Var v => Locks (Neg v x) v where
335 locks = inputsLockOutputs
336 instance (Var v, Num x) => FunctionSimulation (Neg v x) v x where
337 simulate cntx (Neg (I i) (O o)) =
338 let x1 = cntx `getCntx` i
339 y = -x1
340 in [(v, y) | v <- elems o]
341
342 data Constant v x = Constant (X x) (O v) deriving (Typeable, Eq)
343 instance Show x => Label (Constant v x) where label (Constant (X x) _) = show x
344 instance (Var v, Show x) => Show (Constant v x) where
345 show (Constant (X x) os) = "const(" <> show x <> ") = " <> show os
346 constant :: (Var v, Val x) => x -> [v] -> F v x
347 constant x vs = packF $ Constant (X x) $ O $ fromList vs
348 isConst f
349 | Just Constant{} <- castF f = True
350 | otherwise = False
351
352 instance (Show x, Eq x, Typeable x) => Function (Constant v x) v where
353 outputs (Constant _ o) = variables o
354 instance Var v => Patch (Constant v x) (v, v) where
355 patch diff (Constant x a) = Constant x (patch diff a)
356 instance Var v => Locks (Constant v x) v where locks _ = []
357 instance FunctionSimulation (Constant v x) v x where
358 simulate _cntx (Constant (X x) (O vs)) = [(v, x) | v <- elems vs]
359
360 -- TODO: separete into two different functions
361
362 -- | Functional unit that implements logic shift operations
363 data ShiftLR v x
364 = ShiftL Int (I v) (O v)
365 | ShiftR Int (I v) (O v)
366 deriving (Typeable, Eq)
367
368 instance Var v => Show (ShiftLR v x) where
369 show (ShiftL s i os) = show i <> " << " <> show s <> " = " <> show os
370 show (ShiftR s i os) = show i <> " >> " <> show s <> " = " <> show os
371 instance Var v => Label (ShiftLR v x) where label = show
372
373 shiftL :: (Var v, Val x) => Int -> v -> [v] -> F v x
374 shiftL s i o = packF $ ShiftL s (I i) $ O $ fromList o
375 shiftR :: (Var v, Val x) => Int -> v -> [v] -> F v x
376 shiftR s i o = packF $ ShiftR s (I i) $ O $ fromList o
377
378 instance Var v => Function (ShiftLR v x) v where
379 inputs (ShiftL _ i _) = variables i
380 inputs (ShiftR _ i _) = variables i
381 outputs (ShiftL _ _ o) = variables o
382 outputs (ShiftR _ _ o) = variables o
383 instance Var v => Patch (ShiftLR v x) (v, v) where
384 patch diff (ShiftL s i o) = ShiftL s (patch diff i) (patch diff o)
385 patch diff (ShiftR s i o) = ShiftR s (patch diff i) (patch diff o)
386 instance Var v => Locks (ShiftLR v x) v where
387 locks = inputsLockOutputs
388 instance (Var v, B.Bits x) => FunctionSimulation (ShiftLR v x) v x where
389 simulate cntx (ShiftL s (I i) (O os)) = do
390 [(o, getCntx cntx i `B.shiftL` s) | o <- elems os]
391 simulate cntx (ShiftR s (I i) (O os)) = do
392 [(o, getCntx cntx i `B.shiftR` s) | o <- elems os]
393
394 newtype Send v x = Send (I v) deriving (Typeable, Eq)
395 instance Var v => Show (Send v x) where
396 show (Send i) = "send(" <> show i <> ")"
397 instance Label (Send v x) where label Send{} = "send"
398 send :: (Var v, Val x) => v -> F v x
399 send a = packF $ Send $ I a
400 instance Var v => Function (Send v x) v where
401 inputs (Send i) = variables i
402 instance Var v => Patch (Send v x) (v, v) where
403 patch diff (Send a) = Send (patch diff a)
404 instance Var v => Locks (Send v x) v where locks _ = []
405 instance FunctionSimulation (Send v x) v x where
406 simulate _cntx Send{} = []
407
408 newtype Receive v x = Receive (O v) deriving (Typeable, Eq)
409 instance Var v => Show (Receive v x) where
410 show (Receive os) = "receive() = " <> show os
411 instance Label (Receive v x) where label Receive{} = "receive"
412 receive :: (Var v, Val x) => [v] -> F v x
413 receive a = packF $ Receive $ O $ fromList a
414 instance Var v => Function (Receive v x) v where
415 outputs (Receive o) = variables o
416 instance Var v => Patch (Receive v x) (v, v) where
417 patch diff (Receive a) = Receive (patch diff a)
418 instance Var v => Locks (Receive v x) v where locks _ = []
419 instance (Var v, Val x) => FunctionSimulation (Receive v x) v x where
420 simulate CycleCntx{cycleCntx} (Receive (O vs)) =
421 case oneOf vs `HM.lookup` cycleCntx of
422 -- if output variables are defined - nothing to do (values thrown on upper level)
423 Just _ -> []
424 -- if output variables are not defined - set initial value
425 Nothing -> [(v, def) | v <- elems vs]
426
427 -- | Special function for negative tests only.
428 data BrokenBuffer v x = BrokenBuffer (I v) (O v) deriving (Typeable, Eq)
429
430 instance Label (BrokenBuffer v x) where label BrokenBuffer{} = "broken"
431 instance Var v => Show (BrokenBuffer v x) where
432 show (BrokenBuffer i os) = "brokenBuffer(" <> show i <> ")" <> " = " <> show os
433 brokenBuffer :: (Var v, Val x) => v -> [v] -> F v x
434 brokenBuffer a b = packF $ BrokenBuffer (I a) (O $ fromList b)
435
436 instance Var v => Function (BrokenBuffer v x) v where
437 inputs (BrokenBuffer a _b) = variables a
438 outputs (BrokenBuffer _a b) = variables b
439 instance Var v => Patch (BrokenBuffer v x) (v, v) where
440 patch diff (BrokenBuffer a b) = BrokenBuffer (patch diff a) (patch diff b)
441 instance Var v => Locks (BrokenBuffer v x) v where
442 locks = inputsLockOutputs
443 instance Var v => FunctionSimulation (BrokenBuffer v x) v x where
444 simulate cntx (BrokenBuffer (I a) (O vs)) = [(v, cntx `getCntx` a) | v <- elems vs]