never executed always true always false
1 {-# LANGUAGE AllowAmbiguousTypes #-}
2 {-# LANGUAGE DeriveDataTypeable #-}
3 {-# LANGUAGE DuplicateRecordFields #-}
4 {-# LANGUAGE GADTs #-}
5 {-# LANGUAGE StandaloneDeriving #-}
6
7 {- |
8 Module : NITTA.Intermediate.Functions
9 Description : Library of functions
10 Copyright : (c) Aleksandr Penskoi, 2019
11 License : BSD3
12 Maintainer : aleksandr.penskoi@gmail.com
13 Stability : experimental
14
15 Library of functions for an intermediate algorithm representation. Execution
16 relations between functions and process units are many-to-many.
17
18 [@function (functional block)@] atomic operation in intermediate algorithm
19 representation. Function has zero or many inputs and zero or many output.
20 Function can contains state between process cycles.
21 -}
22 module NITTA.Intermediate.Functions (
23 -- * Arithmetics
24 Add (..),
25 add,
26 Division (..),
27 division,
28 Multiply (..),
29 multiply,
30 ShiftLR (..),
31 shiftL,
32 shiftR,
33 Sub (..),
34 sub,
35 Neg (..),
36 neg,
37 module NITTA.Intermediate.Functions.Accum,
38
39 -- * Memory
40 Constant (..),
41 constant,
42 isConst,
43 Loop (..),
44 loop,
45 isLoop,
46 LoopEnd (..),
47 LoopBegin (..),
48 Buffer (..),
49 buffer,
50
51 -- * Input/Output
52 Receive (..),
53 receive,
54 Send (..),
55 send,
56
57 -- * Internal
58 BrokenBuffer (..),
59 brokenBuffer,
60 Compare (..),
61 CmpOp (..),
62 cmp,
63 TruthTable (..),
64 LogicFunction (..),
65 logicAnd,
66 logicOr,
67 logicNot,
68 Mux (..),
69 mux,
70 ) where
71
72 import Data.Bits qualified as B
73 import Data.Data (Data)
74 import Data.Default
75 import Data.HashMap.Strict qualified as HM
76 import Data.Map qualified as M
77 import Data.Set qualified as S
78 import Data.Typeable
79 import GHC.Generics
80 import NITTA.Intermediate.Functions.Accum
81 import NITTA.Intermediate.Types
82 import NITTA.Utils.Base
83
84 {- | Loop -- function for transfer data between computational cycles.
85 Let see the simple example with the following implementation of the
86 Fibonacci algorithm.
87
88 Data flow graph:
89
90 @
91 +---------------------------------+
92 | |
93 v |
94 +------+ b2 |
95 | Loop | b1_1 +-----+ +------+
96 +------+----+------>| | |
97 | a1 | sum +----+
98 +------+----------->| |
99 | Loop | | +-----+ b1_2
100 +------+ +-------------------------+
101 ^ |
102 | |
103 +---------------------------------+
104 @
105
106 Lua source code:
107
108 @
109 function fib(a1, b1)
110 b2 = a1 + b1
111 fib(b1, b2)
112 end
113 fib(0, 1)
114 @
115
116 Data flow defines computation for a single computational cycle. But
117 a controller should repeat the algorithm infinite times, and
118 usually, it is required to transfer data between cycles. `Loop`
119 allows doing that. At first cycle, `Loop` function produces an
120 initial value (`X x`), after that on each cycle `Loop` produces a
121 variable value from the previous cycle, and consumes a new value at
122 the end of the cycle.
123
124 Computational process:
125
126 @
127 ][ Cycle 1 ][ Cycle 2 ]
128 ][ ][ ]
129 initial ][ ---+ b2 +--- ][ ---+ b2 +--- ]
130 value ][ op | b1_1 +-----+ +------>| Lo ][ op | b1_1 +-----+ +------>| Lo ]
131 is a ][ ---+----+------>| | | +--- ][ ---+----+------>| | | +--- ]
132 part of ][ | | sum +----+ ][ | | sum +----+ ]
133 software ][ ---+----------->| | +--- ][ ---+----------->| | +--- ]
134 ][ op | | +-----+ b1_2 | Lo ][ op | | +-----+ b1_2 | Lo ]
135 ][ ---+ +------------------------->+--- ][ ---+ +------------------------->+--- ]
136 ][ ][ ]
137 @
138
139 Similation data:
140
141 +--------------+----+----+----+
142 | Cycle number | a1 | b1 | b2 |
143 +==============+====+====+====+
144 | 1 | 0 | 1 | 1 |
145 +--------------+----+----+----+
146 | 2 | 1 | 1 | 2 |
147 +--------------+----+----+----+
148 | 3 | 1 | 2 | 3 |
149 +--------------+----+----+----+
150 | 4 | 2 | 3 | 5 |
151 +--------------+----+----+----+
152
153 In practice, Loop function supported by Fram processor unit in the
154 following way: Loop function should be prepared before execution by
155 automatical refactor @BreakLoop@, which replace Loop by @LoopEnd@
156 and @LoopBegin@.
157 -}
158 data Loop v x = Loop (X x) (O v) (I v) deriving (Typeable, Eq)
159
160 instance (Var v, Show x) => Show (Loop v x) where show = label
161 instance (Var v, Show x) => Label (Loop v x) where
162 label (Loop (X x) os i) =
163 "loop(" <> show x <> ", " <> show i <> ") = " <> show os
164 loop :: (Var v, Val x) => x -> v -> [v] -> F v x
165 loop x a bs = packF $ Loop (X x) (O $ S.fromList bs) $ I a
166 isLoop f
167 | Just Loop{} <- castF f = True
168 | otherwise = False
169
170 instance Function (Loop v x) v where
171 isInternalLockPossible _ = True
172 inputs (Loop _ _a b) = variables b
173 outputs (Loop _ a _b) = variables a
174 instance Var v => Patch (Loop v x) (v, v) where
175 patch diff (Loop x a b) = Loop x (patch diff a) (patch diff b)
176 instance Var v => Locks (Loop v x) v where
177 locks (Loop _ (O as) (I b)) = [Lock{locked = b, lockBy = a} | a <- S.elems as]
178 instance Var v => FunctionSimulation (Loop v x) v x where
179 simulate CycleCntx{cycleCntx} (Loop (X x) (O vs) (I _)) =
180 case oneOf vs `HM.lookup` cycleCntx of
181 -- if output variables are defined - nothing to do (values thrown on upper level)
182 Just _ -> []
183 -- if output variables are not defined - set initial value
184 Nothing -> [(v, x) | v <- S.elems vs]
185
186 data LoopBegin v x = LoopBegin (Loop v x) (O v) deriving (Typeable, Eq)
187 instance (Var v, Show x) => Show (LoopBegin v x) where show = label
188 instance Var v => Label (LoopBegin v x) where
189 label (LoopBegin _ os) = "LoopBegin() = " <> show os
190 instance Var v => Function (LoopBegin v x) v where
191 outputs (LoopBegin _ o) = variables o
192 isInternalLockPossible _ = True
193 instance Var v => Patch (LoopBegin v x) (v, v) where
194 patch diff (LoopBegin l a) = LoopBegin (patch diff l) $ patch diff a
195 instance Var v => Locks (LoopBegin v x) v where
196 locks _ = []
197 instance Var v => FunctionSimulation (LoopBegin v x) v x where
198 simulate cntx (LoopBegin l _) = simulate cntx l
199
200 data LoopEnd v x = LoopEnd (Loop v x) (I v) deriving (Typeable, Eq)
201 instance (Var v, Show x) => Show (LoopEnd v x) where show = label
202 instance Var v => Label (LoopEnd v x) where
203 label (LoopEnd (Loop _ os _) i) = "LoopEnd(" <> show i <> ") pair out: " <> show os
204 instance Var v => Function (LoopEnd v x) v where
205 inputs (LoopEnd _ o) = variables o
206 isInternalLockPossible _ = True
207 instance Var v => Patch (LoopEnd v x) (v, v) where
208 patch diff (LoopEnd l a) = LoopEnd (patch diff l) $ patch diff a
209 instance Var v => Locks (LoopEnd v x) v where locks (LoopEnd l _) = locks l
210 instance Var v => FunctionSimulation (LoopEnd v x) v x where
211 simulate cntx (LoopEnd l _) = simulate cntx l
212
213 data Buffer v x = Buffer (I v) (O v) deriving (Typeable, Eq)
214 instance Label (Buffer v x) where label Buffer{} = "buf"
215 instance Var v => Show (Buffer v x) where
216 show (Buffer i os) = "buffer(" <> show i <> ")" <> " = " <> show os
217 buffer :: (Var v, Val x) => v -> [v] -> F v x
218 buffer a b = packF $ Buffer (I a) (O $ S.fromList b)
219
220 instance Var v => Function (Buffer v x) v where
221 inputs (Buffer a _b) = variables a
222 outputs (Buffer _a b) = variables b
223 instance Var v => Patch (Buffer v x) (v, v) where
224 patch diff (Buffer a b) = Buffer (patch diff a) (patch diff b)
225 instance Var v => Locks (Buffer v x) v where
226 locks = inputsLockOutputs
227 instance Var v => FunctionSimulation (Buffer v x) v x where
228 simulate cntx (Buffer (I a) (O vs)) =
229 [(v, cntx `getCntx` a) | v <- S.elems vs]
230
231 data Add v x = Add (I v) (I v) (O v) deriving (Typeable, Eq)
232 instance Label (Add v x) where label Add{} = "+"
233 instance Var v => Show (Add v x) where
234 show (Add a b c) =
235 let lexp = show a <> " + " <> show b
236 rexp = show c
237 in lexp <> " = " <> rexp
238 add :: (Var v, Val x) => v -> v -> [v] -> F v x
239 add a b c = packF $ Add (I a) (I b) $ O $ S.fromList c
240
241 instance Var v => Function (Add v x) v where
242 inputs (Add a b _c) = variables a `S.union` variables b
243 outputs (Add _a _b c) = variables c
244 instance Var v => Patch (Add v x) (v, v) where
245 patch diff (Add a b c) = Add (patch diff a) (patch diff b) (patch diff c)
246 instance Var v => Locks (Add v x) v where
247 locks = inputsLockOutputs
248 instance (Var v, Num x) => FunctionSimulation (Add v x) v x where
249 simulate cntx (Add (I v1) (I v2) (O vs)) =
250 let x1 = cntx `getCntx` v1
251 x2 = cntx `getCntx` v2
252 y = x1 + x2
253 in [(v, y) | v <- S.elems vs]
254
255 data Sub v x = Sub (I v) (I v) (O v) deriving (Typeable, Eq)
256 instance Label (Sub v x) where label Sub{} = "-"
257 instance Var v => Show (Sub v x) where
258 show (Sub a b c) =
259 let lexp = show a <> " - " <> show b
260 rexp = show c
261 in lexp <> " = " <> rexp
262 sub :: (Var v, Val x) => v -> v -> [v] -> F v x
263 sub a b c = packF $ Sub (I a) (I b) $ O $ S.fromList c
264
265 instance Var v => Function (Sub v x) v where
266 inputs (Sub a b _c) = variables a `S.union` variables b
267 outputs (Sub _a _b c) = variables c
268 instance Var v => Patch (Sub v x) (v, v) where
269 patch diff (Sub a b c) = Sub (patch diff a) (patch diff b) (patch diff c)
270 instance Var v => Locks (Sub v x) v where
271 locks = inputsLockOutputs
272 instance (Var v, Num x) => FunctionSimulation (Sub v x) v x where
273 simulate cntx (Sub (I v1) (I v2) (O vs)) =
274 let x1 = cntx `getCntx` v1
275 x2 = cntx `getCntx` v2
276 y = x1 - x2
277 in [(v, y) | v <- S.elems vs]
278
279 data Multiply v x = Multiply (I v) (I v) (O v) deriving (Typeable, Eq)
280 instance Label (Multiply v x) where label Multiply{} = "*"
281 instance Var v => Show (Multiply v x) where
282 show (Multiply a b c) =
283 show a <> " * " <> show b <> " = " <> show c
284 multiply :: (Var v, Val x) => v -> v -> [v] -> F v x
285 multiply a b c = packF $ Multiply (I a) (I b) $ O $ S.fromList c
286
287 instance Var v => Function (Multiply v x) v where
288 inputs (Multiply a b _c) = variables a `S.union` variables b
289 outputs (Multiply _a _b c) = variables c
290 instance Var v => Patch (Multiply v x) (v, v) where
291 patch diff (Multiply a b c) = Multiply (patch diff a) (patch diff b) (patch diff c)
292 instance Var v => Locks (Multiply v x) v where
293 locks = inputsLockOutputs
294 instance (Var v, Num x) => FunctionSimulation (Multiply v x) v x where
295 simulate cntx (Multiply (I v1) (I v2) (O vs)) =
296 let x1 = cntx `getCntx` v1
297 x2 = cntx `getCntx` v2
298 y = x1 * x2
299 in [(v, y) | v <- S.elems vs]
300
301 data Division v x = Division
302 { denom, numer :: I v
303 , quotient, remain :: O v
304 }
305 deriving (Typeable, Eq)
306 instance Label (Division v x) where label Division{} = "/"
307 instance Var v => Show (Division v x) where
308 show Division{denom, numer, quotient, remain} =
309 let q = show numer <> " / " <> show denom <> " = " <> show quotient
310 r = show numer <> " mod " <> show denom <> " = " <> show remain
311 in q <> "; " <> r
312 division :: (Var v, Val x) => v -> v -> [v] -> [v] -> F v x
313 division d n q r =
314 packF $
315 Division
316 { denom = I d
317 , numer = I n
318 , quotient = O $ S.fromList q
319 , remain = O $ S.fromList r
320 }
321
322 instance Var v => Function (Division v x) v where
323 inputs Division{denom, numer} = variables denom `S.union` variables numer
324 outputs Division{quotient, remain} = variables quotient `S.union` variables remain
325 instance Var v => Patch (Division v x) (v, v) where
326 patch diff (Division a b c d) = Division (patch diff a) (patch diff b) (patch diff c) (patch diff d)
327 instance Var v => Locks (Division v x) v where
328 locks = inputsLockOutputs
329 instance (Var v, Val x) => FunctionSimulation (Division v x) v x where
330 simulate cntx Division{denom = I d, numer = I n, quotient = O qs, remain = O rs} =
331 let dx = cntx `getCntx` d
332 nx = cntx `getCntx` n
333 qx = fromRaw (rawData dx * 2 ^ scalingFactorPower dx `div` rawData nx) def
334 rx = dx `mod` nx
335 in [(v, qx) | v <- S.elems qs] ++ [(v, rx) | v <- S.elems rs]
336
337 data Neg v x = Neg (I v) (O v) deriving (Typeable, Eq)
338 instance Label (Neg v x) where label Neg{} = "neg"
339 instance Var v => Show (Neg v x) where
340 show (Neg i o) = "-" <> show i <> " = " <> show o
341
342 neg :: (Var v, Val x) => v -> [v] -> F v x
343 neg i o = packF $ Neg (I i) $ O $ S.fromList o
344
345 instance Ord v => Function (Neg v x) v where
346 inputs (Neg i _) = variables i
347 outputs (Neg _ o) = variables o
348 instance Ord v => Patch (Neg v x) (v, v) where
349 patch diff (Neg i o) = Neg (patch diff i) (patch diff o)
350 instance Var v => Locks (Neg v x) v where
351 locks = inputsLockOutputs
352 instance (Var v, Num x) => FunctionSimulation (Neg v x) v x where
353 simulate cntx (Neg (I i) (O o)) =
354 let x1 = cntx `getCntx` i
355 y = -x1
356 in [(v, y) | v <- S.elems o]
357
358 data Constant v x = Constant (X x) (O v) deriving (Typeable, Eq)
359 instance Show x => Label (Constant v x) where label (Constant (X x) _) = show x
360 instance (Var v, Show x) => Show (Constant v x) where
361 show (Constant (X x) os) = "const(" <> show x <> ") = " <> show os
362 constant :: (Var v, Val x) => x -> [v] -> F v x
363 constant x vs = packF $ Constant (X x) $ O $ S.fromList vs
364 isConst f
365 | Just Constant{} <- castF f = True
366 | otherwise = False
367
368 instance (Show x, Eq x, Typeable x) => Function (Constant v x) v where
369 outputs (Constant _ o) = variables o
370 instance Var v => Patch (Constant v x) (v, v) where
371 patch diff (Constant x a) = Constant x (patch diff a)
372 instance Var v => Locks (Constant v x) v where locks _ = []
373 instance FunctionSimulation (Constant v x) v x where
374 simulate _cntx (Constant (X x) (O vs)) = [(v, x) | v <- S.elems vs]
375
376 -- TODO: separete into two different functions
377
378 -- | Functional unit that implements logic shift operations
379 data ShiftLR v x
380 = ShiftL Int (I v) (O v)
381 | ShiftR Int (I v) (O v)
382 deriving (Typeable, Eq)
383
384 instance Var v => Show (ShiftLR v x) where
385 show (ShiftL s i os) = show i <> " << " <> show s <> " = " <> show os
386 show (ShiftR s i os) = show i <> " >> " <> show s <> " = " <> show os
387 instance Var v => Label (ShiftLR v x) where label = show
388
389 shiftL :: (Var v, Val x) => Int -> v -> [v] -> F v x
390 shiftL s i o = packF $ ShiftL s (I i) $ O $ S.fromList o
391 shiftR :: (Var v, Val x) => Int -> v -> [v] -> F v x
392 shiftR s i o = packF $ ShiftR s (I i) $ O $ S.fromList o
393
394 instance Var v => Function (ShiftLR v x) v where
395 inputs (ShiftL _ i _) = variables i
396 inputs (ShiftR _ i _) = variables i
397 outputs (ShiftL _ _ o) = variables o
398 outputs (ShiftR _ _ o) = variables o
399 instance Var v => Patch (ShiftLR v x) (v, v) where
400 patch diff (ShiftL s i o) = ShiftL s (patch diff i) (patch diff o)
401 patch diff (ShiftR s i o) = ShiftR s (patch diff i) (patch diff o)
402 instance Var v => Locks (ShiftLR v x) v where
403 locks = inputsLockOutputs
404 instance (Var v, B.Bits x) => FunctionSimulation (ShiftLR v x) v x where
405 simulate cntx (ShiftL s (I i) (O os)) = do
406 [(o, getCntx cntx i `B.shiftL` s) | o <- S.elems os]
407 simulate cntx (ShiftR s (I i) (O os)) = do
408 [(o, getCntx cntx i `B.shiftR` s) | o <- S.elems os]
409
410 newtype Send v x = Send (I v) deriving (Typeable, Eq)
411 instance Var v => Show (Send v x) where
412 show (Send i) = "send(" <> show i <> ")"
413 instance Label (Send v x) where label Send{} = "send"
414 send :: (Var v, Val x) => v -> F v x
415 send a = packF $ Send $ I a
416 instance Var v => Function (Send v x) v where
417 inputs (Send i) = variables i
418 instance Var v => Patch (Send v x) (v, v) where
419 patch diff (Send a) = Send (patch diff a)
420 instance Var v => Locks (Send v x) v where locks _ = []
421 instance FunctionSimulation (Send v x) v x where
422 simulate _cntx Send{} = []
423
424 newtype Receive v x = Receive (O v) deriving (Typeable, Eq)
425 instance Var v => Show (Receive v x) where
426 show (Receive os) = "receive() = " <> show os
427 instance Label (Receive v x) where label Receive{} = "receive"
428 receive :: (Var v, Val x) => [v] -> F v x
429 receive a = packF $ Receive $ O $ S.fromList a
430 instance Var v => Function (Receive v x) v where
431 outputs (Receive o) = variables o
432 instance Var v => Patch (Receive v x) (v, v) where
433 patch diff (Receive a) = Receive (patch diff a)
434 instance Var v => Locks (Receive v x) v where locks _ = []
435 instance (Var v, Val x) => FunctionSimulation (Receive v x) v x where
436 simulate CycleCntx{cycleCntx} (Receive (O vs)) =
437 case oneOf vs `HM.lookup` cycleCntx of
438 -- if output variables are defined - nothing to do (values thrown on upper level)
439 Just _ -> []
440 -- if output variables are not defined - set initial value
441 Nothing -> [(v, def) | v <- S.elems vs]
442
443 -- | Special function for negative tests only.
444 data BrokenBuffer v x = BrokenBuffer (I v) (O v) deriving (Typeable, Eq)
445
446 instance Label (BrokenBuffer v x) where label BrokenBuffer{} = "broken"
447 instance Var v => Show (BrokenBuffer v x) where
448 show (BrokenBuffer i os) = "brokenBuffer(" <> show i <> ")" <> " = " <> show os
449 brokenBuffer :: (Var v, Val x) => v -> [v] -> F v x
450 brokenBuffer a b = packF $ BrokenBuffer (I a) (O $ S.fromList b)
451
452 instance Var v => Function (BrokenBuffer v x) v where
453 inputs (BrokenBuffer a _b) = variables a
454 outputs (BrokenBuffer _a b) = variables b
455 instance Var v => Patch (BrokenBuffer v x) (v, v) where
456 patch diff (BrokenBuffer a b) = BrokenBuffer (patch diff a) (patch diff b)
457 instance Var v => Locks (BrokenBuffer v x) v where
458 locks = inputsLockOutputs
459 instance Var v => FunctionSimulation (BrokenBuffer v x) v x where
460 simulate cntx (BrokenBuffer (I a) (O vs)) = [(v, cntx `getCntx` a) | v <- S.elems vs]
461
462 data CmpOp = CmpEq | CmpLt | CmpLte | CmpGt | CmpGte
463 deriving (Typeable, Eq, Show, Data, Generic)
464
465 data Compare v x = Compare CmpOp (I v) (I v) (O v) deriving (Typeable, Eq)
466 instance Label (Compare v x) where
467 label (Compare op _ _ _) = show op
468 instance Var v => Patch (Compare v x) (v, v) where
469 patch diff (Compare op a b c) = Compare op (patch diff a) (patch diff b) (patch diff c)
470
471 instance Var v => Show (Compare v x) where
472 show (Compare op a b o) = show a <> " " <> show op <> " " <> show b <> " = " <> show o
473
474 instance Var v => Function (Compare v x) v where
475 inputs (Compare _ a b _) = variables a `S.union` variables b
476 outputs (Compare _ _ _ o) = variables o
477 instance (Var v, Val x) => FunctionSimulation (Compare v x) v x where
478 simulate cntx (Compare op (I a) (I b) (O o)) =
479 let
480 x1 = getCntx cntx a
481 x2 = getCntx cntx b
482 y = if op2func op x1 x2 then 1 else 0
483 in
484 [(v, y) | v <- S.elems o]
485 where
486 op2func CmpEq = (==)
487 op2func CmpLt = (<)
488 op2func CmpLte = (<=)
489 op2func CmpGt = (>)
490 op2func CmpGte = (>=)
491 instance Var v => Locks (Compare v x) v where
492 locks = inputsLockOutputs
493
494 cmp :: (Var v, Val x) => CmpOp -> v -> v -> [v] -> F v x
495 cmp op a b c = packF $ Compare op (I a) (I b) $ O $ S.fromList c
496 data LogicFunction v x
497 = LogicAnd (I v) (I v) (O v)
498 | LogicOr (I v) (I v) (O v)
499 | LogicNot (I v) (O v)
500 deriving (Typeable, Eq)
501
502 deriving instance (Data v, Data (I v), Data (O v), Data x) => Data (LogicFunction v x)
503
504 logicAnd :: (Var v, Val x) => v -> v -> [v] -> F v x
505 logicAnd a b c = packF $ LogicAnd (I a) (I b) $ O $ S.fromList c
506
507 logicOr :: (Var v, Val x) => v -> v -> [v] -> F v x
508 logicOr a b c = packF $ LogicOr (I a) (I b) $ O $ S.fromList c
509
510 logicNot :: (Var v, Val x) => v -> [v] -> F v x
511 logicNot a c = packF $ LogicNot (I a) $ O $ S.fromList c
512
513 instance Label (LogicFunction v x) where
514 label LogicAnd{} = "and"
515 label LogicOr{} = "or"
516 label LogicNot{} = "not"
517
518 instance Var v => Patch (LogicFunction v x) (v, v) where
519 patch diff (LogicAnd a b c) = LogicAnd (patch diff a) (patch diff b) (patch diff c)
520 patch diff (LogicOr a b c) = LogicOr (patch diff a) (patch diff b) (patch diff c)
521 patch diff (LogicNot a b) = LogicNot (patch diff a) (patch diff b)
522
523 instance Var v => Show (LogicFunction v x) where
524 show (LogicAnd a b o) = show a <> " and " <> show b <> " = " <> show o
525 show (LogicOr a b o) = show a <> " or " <> show b <> " = " <> show o
526 show (LogicNot a o) = "not " <> show a <> " = " <> show o
527
528 instance Var v => Function (LogicFunction v x) v where
529 inputs (LogicOr a b _) = variables a `S.union` variables b
530 inputs (LogicAnd a b _) = variables a `S.union` variables b
531 inputs (LogicNot a _) = variables a
532 outputs (LogicOr _ _ o) = variables o
533 outputs (LogicAnd _ _ o) = variables o
534 outputs (LogicNot _ o) = variables o
535 instance (Var v, B.Bits x, Num x, Ord x) => FunctionSimulation (LogicFunction v x) v x where
536 simulate cntx (LogicAnd (I a) (I b) (O o)) =
537 let x1 = toBool (cntx `getCntx` a)
538 x2 = toBool (cntx `getCntx` b)
539 y = x1 * x2
540 in [(v, y) | v <- S.elems o]
541 simulate cntx (LogicOr (I a) (I b) (O o)) =
542 let x1 = toBool (cntx `getCntx` a)
543 x2 = toBool (cntx `getCntx` b)
544 y = if x1 + x2 > 0 then 1 else 0
545 in [(v, y) | v <- S.elems o]
546 simulate cntx (LogicNot (I a) (O o)) =
547 let x1 = toBool (cntx `getCntx` a)
548 y = 1 - x1
549 in [(v, y) | v <- S.elems o]
550
551 toBool :: (Num x, Eq x) => x -> x
552 toBool n = if n /= 0 then 1 else 0
553
554 instance Var v => Locks (LogicFunction v x) v where
555 locks = inputsLockOutputs
556
557 -- Look Up Table
558 data TruthTable v x = TruthTable (M.Map [Bool] Bool) [I v] (O v) deriving (Typeable, Eq)
559
560 instance Var v => Patch (TruthTable v x) (v, v) where
561 patch (old, new) (TruthTable table ins out) =
562 TruthTable table (patch (old, new) ins) (patch (old, new) out)
563
564 instance Var v => Locks (TruthTable v x) v where
565 locks (TruthTable{}) = []
566
567 instance Label (TruthTable v x) where
568 label (TruthTable{}) = "TruthTable"
569 instance Var v => Show (TruthTable v x) where
570 show (TruthTable table ins output) = "TruthTable " <> show table <> " " <> show ins <> " = " <> show output
571
572 instance Var v => Function (TruthTable v x) v where
573 inputs (TruthTable _ ins _) = S.unions $ map variables ins
574 outputs (TruthTable _ _ output) = variables output
575
576 instance (Var v, Num x, Eq x) => FunctionSimulation (TruthTable v x) v x where
577 simulate cntx (TruthTable table ins (O output)) =
578 let inputValues = map (\(I v) -> cntx `getCntx` v == 1) ins
579 result = M.findWithDefault False inputValues table -- todo add default value
580 in [(v, fromIntegral (fromEnum result)) | v <- S.elems output]
581
582 data Mux v x = Mux (I v) [I v] (O v) deriving (Typeable, Eq)
583
584 instance Var v => Patch (Mux v x) (v, v) where
585 patch (old, new) (Mux sel ins out) =
586 Mux (patch (old, new) sel) ins (patch (old, new) out)
587
588 instance Var v => Locks (Mux v x) v where
589 locks (Mux{}) = []
590
591 instance Label (Mux v x) where
592 label (Mux{}) = "Mux"
593 instance Var v => Show (Mux v x) where
594 show (Mux ins sel output) = "Mux " <> show ins <> " " <> show sel <> " = " <> show output
595
596 instance Var v => Function (Mux v x) v where
597 inputs (Mux cond ins _) =
598 S.unions $ map variables (ins ++ [cond])
599 outputs (Mux _ _ output) = variables output
600
601 instance (Var v, Val x) => FunctionSimulation (Mux v x) v x where
602 simulate cntx (Mux (I sel) ins (O outs)) =
603 let
604 selValue = getCntx cntx sel `mod` 16
605 insCount = length ins
606 selectedValue
607 | selValue >= 0 && fromIntegral selValue < insCount =
608 case ins !! fromIntegral (selValue `mod` 16) of
609 I inputVar -> getCntx cntx inputVar
610 | otherwise = 0
611 in
612 [(outVar, selectedValue) | outVar <- S.elems outs]
613
614 mux :: (Var v, Val x) => [v] -> v -> [v] -> F v x
615 mux inps cond outs = packF $ Mux (I cond) (map I inps) $ O $ S.fromList outs