{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE StandaloneDeriving #-}

{- |
Module      : NITTA.Intermediate.Functions
Description : Library of functions
Copyright   : (c) Aleksandr Penskoi, 2019
License     : BSD3
Maintainer  : aleksandr.penskoi@gmail.com
Stability   : experimental

Library of functions for an intermediate algorithm representation. Execution
relations between functions and process units are many-to-many.

[@function (functional block)@] atomic operation in intermediate algorithm
representation. Function has zero or many inputs and zero or many output.
Function can contains state between process cycles.
-}
module NITTA.Intermediate.Functions (
    -- * Arithmetics
    Add (..),
    add,
    Division (..),
    division,
    Multiply (..),
    multiply,
    ShiftLR (..),
    shiftL,
    shiftR,
    Sub (..),
    sub,
    Neg (..),
    neg,
    module NITTA.Intermediate.Functions.Accum,

    -- * Memory
    Constant (..),
    constant,
    isConst,
    Loop (..),
    loop,
    isLoop,
    LoopEnd (..),
    LoopBegin (..),
    Buffer (..),
    buffer,

    -- * Input/Output
    Receive (..),
    receive,
    Send (..),
    send,

    -- * Internal
    BrokenBuffer (..),
    brokenBuffer,
    Compare (..),
    CmpOp (..),
    cmp,
    TruthTable (..),
    LogicFunction (..),
    logicAnd,
    logicOr,
    logicNot,
    Mux (..),
    mux,
) where

import Data.Bits qualified as B
import Data.Data (Data)
import Data.Default
import Data.HashMap.Strict qualified as HM
import Data.Map qualified as M
import Data.Set qualified as S
import Data.Typeable
import GHC.Generics
import NITTA.Intermediate.Functions.Accum
import NITTA.Intermediate.Types
import NITTA.Utils.Base

{- | Loop -- function for transfer data between computational cycles.
Let see the simple example with the following implementation of the
Fibonacci algorithm.

Data flow graph:

@
    +---------------------------------+
    |                                 |
    v                                 |
+------+                          b2  |
| Loop |      b1_1  +-----+    +------+
+------+----+------>|     |    |
            | a1    | sum +----+
+------+----------->|     |
| Loop |    |       +-----+      b1_2
+------+    +-------------------------+
    ^                                 |
    |                                 |
    +---------------------------------+
@

Lua source code:

@
function fib(a1, b1)
    b2 = a1 + b1
    fib(b1, b2)
end
fib(0, 1)
@

Data flow defines computation for a single computational cycle. But
a controller should repeat the algorithm infinite times, and
usually, it is required to transfer data between cycles. `Loop`
allows doing that. At first cycle, `Loop` function produces an
initial value (`X x`), after that on each cycle `Loop` produces a
variable value from the previous cycle, and consumes a new value at
the end of the cycle.

Computational process:

@
         ][                 Cycle 1                 ][                Cycle 2                  ]
         ][                                         ][                                         ]
initial  ][ ---+                          b2   +--- ][ ---+                          b2   +--- ]
 value   ][ op |      b1_1  +-----+    +------>| Lo ][ op |      b1_1  +-----+    +------>| Lo ]
 is a    ][ ---+----+------>|     |    |       +--- ][ ---+----+------>|     |    |       +--- ]
part of  ][         |       | sum +----+            ][         |       | sum +----+            ]
software ][ ---+----------->|     |            +--- ][ ---+----------->|     |            +--- ]
         ][ op |    |       +-----+     b1_2   | Lo ][ op |    |       +-----+      b1_2  | Lo ]
         ][ ---+    +------------------------->+--- ][ ---+    +------------------------->+--- ]
         ][                                         ][                                         ]
@

Similation data:

+--------------+----+----+----+
| Cycle number | a1 | b1 | b2 |
+==============+====+====+====+
| 1            | 0  | 1  | 1  |
+--------------+----+----+----+
| 2            | 1  | 1  | 2  |
+--------------+----+----+----+
| 3            | 1  | 2  | 3  |
+--------------+----+----+----+
| 4            | 2  | 3  | 5  |
+--------------+----+----+----+

In practice, Loop function supported by Fram processor unit in the
following way: Loop function should be prepared before execution by
automatical refactor @BreakLoop@, which replace Loop by @LoopEnd@
and @LoopBegin@.
-}
data Loop v x = Loop (X x) (O v) (I v) deriving (Typeable, Loop v x -> Loop v x -> Bool
(Loop v x -> Loop v x -> Bool)
-> (Loop v x -> Loop v x -> Bool) -> Eq (Loop v x)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v x. (Eq x, Eq v) => Loop v x -> Loop v x -> Bool
$c== :: forall v x. (Eq x, Eq v) => Loop v x -> Loop v x -> Bool
== :: Loop v x -> Loop v x -> Bool
$c/= :: forall v x. (Eq x, Eq v) => Loop v x -> Loop v x -> Bool
/= :: Loop v x -> Loop v x -> Bool
Eq)

instance (Var v, Show x) => Show (Loop v x) where show :: Loop v x -> String
show = Loop v x -> String
forall a. Label a => a -> String
label
instance (Var v, Show x) => Label (Loop v x) where
    label :: Loop v x -> String
label (Loop (X x
x) O v
os I v
i) =
        String
"loop(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> x -> String
forall a. Show a => a -> String
show x
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> I v -> String
forall a. Show a => a -> String
show I v
i String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
") = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> O v -> String
forall a. Show a => a -> String
show O v
os
loop :: (Var v, Val x) => x -> v -> [v] -> F v x
loop :: forall v x. (Var v, Val x) => x -> v -> [v] -> F v x
loop x
x v
a [v]
bs = Loop v x -> F v x
forall {f} {v} {x}.
(Function f v, Patch f (v, v), Locks f v, Show f, Label f,
 FunctionSimulation f v x, Typeable f, Eq f) =>
f -> F v x
packF (Loop v x -> F v x) -> Loop v x -> F v x
forall a b. (a -> b) -> a -> b
$ X x -> O v -> I v -> Loop v x
forall v x. X x -> O v -> I v -> Loop v x
Loop (x -> X x
forall x. x -> X x
X x
x) (Set v -> O v
forall v. Set v -> O v
O (Set v -> O v) -> Set v -> O v
forall a b. (a -> b) -> a -> b
$ [v] -> Set v
forall a. Ord a => [a] -> Set a
S.fromList [v]
bs) (I v -> Loop v x) -> I v -> Loop v x
forall a b. (a -> b) -> a -> b
$ v -> I v
forall v. v -> I v
I v
a
isLoop :: F v x -> Bool
isLoop F v x
f
    | Just Loop{} <- F v x -> Maybe (Loop v x)
forall (f :: * -> * -> *) v x.
(Typeable f, Typeable v, Typeable x) =>
F v x -> Maybe (f v x)
castF F v x
f = Bool
True
    | Bool
otherwise = Bool
False

instance Function (Loop v x) v where
    isInternalLockPossible :: Loop v x -> Bool
isInternalLockPossible Loop v x
_ = Bool
True
    inputs :: Loop v x -> Set v
inputs (Loop X x
_ O v
_a I v
b) = I v -> Set v
forall a v. Variables a v => a -> Set v
variables I v
b
    outputs :: Loop v x -> Set v
outputs (Loop X x
_ O v
a I v
_b) = O v -> Set v
forall a v. Variables a v => a -> Set v
variables O v
a
instance Var v => Patch (Loop v x) (v, v) where
    patch :: (v, v) -> Loop v x -> Loop v x
patch (v, v)
diff (Loop X x
x O v
a I v
b) = X x -> O v -> I v -> Loop v x
forall v x. X x -> O v -> I v -> Loop v x
Loop X x
x ((v, v) -> O v -> O v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff O v
a) ((v, v) -> I v -> I v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff I v
b)
instance Var v => Locks (Loop v x) v where
    locks :: Loop v x -> [Lock v]
locks (Loop X x
_ (O Set v
as) (I v
b)) = [Lock{locked :: v
locked = v
b, lockBy :: v
lockBy = v
a} | v
a <- Set v -> [v]
forall a. Set a -> [a]
S.elems Set v
as]
instance Var v => FunctionSimulation (Loop v x) v x where
    simulate :: CycleCntx v x -> Loop v x -> [(v, x)]
simulate CycleCntx{HashMap v x
cycleCntx :: HashMap v x
cycleCntx :: forall v x. CycleCntx v x -> HashMap v x
cycleCntx} (Loop (X x
x) (O Set v
vs) (I v
_)) =
        case Set v -> v
forall {c}. Set c -> c
oneOf Set v
vs v -> HashMap v x -> Maybe x
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
`HM.lookup` HashMap v x
cycleCntx of
            -- if output variables are defined - nothing to do (values thrown on upper level)
            Just x
_ -> []
            -- if output variables are not defined - set initial value
            Maybe x
Nothing -> [(v
v, x
x) | v
v <- Set v -> [v]
forall a. Set a -> [a]
S.elems Set v
vs]

data LoopBegin v x = LoopBegin (Loop v x) (O v) deriving (Typeable, LoopBegin v x -> LoopBegin v x -> Bool
(LoopBegin v x -> LoopBegin v x -> Bool)
-> (LoopBegin v x -> LoopBegin v x -> Bool) -> Eq (LoopBegin v x)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v x. (Eq x, Eq v) => LoopBegin v x -> LoopBegin v x -> Bool
$c== :: forall v x. (Eq x, Eq v) => LoopBegin v x -> LoopBegin v x -> Bool
== :: LoopBegin v x -> LoopBegin v x -> Bool
$c/= :: forall v x. (Eq x, Eq v) => LoopBegin v x -> LoopBegin v x -> Bool
/= :: LoopBegin v x -> LoopBegin v x -> Bool
Eq)
instance (Var v, Show x) => Show (LoopBegin v x) where show :: LoopBegin v x -> String
show = LoopBegin v x -> String
forall a. Label a => a -> String
label
instance Var v => Label (LoopBegin v x) where
    label :: LoopBegin v x -> String
label (LoopBegin Loop v x
_ O v
os) = String
"LoopBegin() = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> O v -> String
forall a. Show a => a -> String
show O v
os
instance Var v => Function (LoopBegin v x) v where
    outputs :: LoopBegin v x -> Set v
outputs (LoopBegin Loop v x
_ O v
o) = O v -> Set v
forall a v. Variables a v => a -> Set v
variables O v
o
    isInternalLockPossible :: LoopBegin v x -> Bool
isInternalLockPossible LoopBegin v x
_ = Bool
True
instance Var v => Patch (LoopBegin v x) (v, v) where
    patch :: (v, v) -> LoopBegin v x -> LoopBegin v x
patch (v, v)
diff (LoopBegin Loop v x
l O v
a) = Loop v x -> O v -> LoopBegin v x
forall v x. Loop v x -> O v -> LoopBegin v x
LoopBegin ((v, v) -> Loop v x -> Loop v x
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff Loop v x
l) (O v -> LoopBegin v x) -> O v -> LoopBegin v x
forall a b. (a -> b) -> a -> b
$ (v, v) -> O v -> O v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff O v
a
instance Var v => Locks (LoopBegin v x) v where
    locks :: LoopBegin v x -> [Lock v]
locks LoopBegin v x
_ = []
instance Var v => FunctionSimulation (LoopBegin v x) v x where
    simulate :: CycleCntx v x -> LoopBegin v x -> [(v, x)]
simulate CycleCntx v x
cntx (LoopBegin Loop v x
l O v
_) = CycleCntx v x -> Loop v x -> [(v, x)]
forall f v x.
FunctionSimulation f v x =>
CycleCntx v x -> f -> [(v, x)]
simulate CycleCntx v x
cntx Loop v x
l

data LoopEnd v x = LoopEnd (Loop v x) (I v) deriving (Typeable, LoopEnd v x -> LoopEnd v x -> Bool
(LoopEnd v x -> LoopEnd v x -> Bool)
-> (LoopEnd v x -> LoopEnd v x -> Bool) -> Eq (LoopEnd v x)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v x. (Eq x, Eq v) => LoopEnd v x -> LoopEnd v x -> Bool
$c== :: forall v x. (Eq x, Eq v) => LoopEnd v x -> LoopEnd v x -> Bool
== :: LoopEnd v x -> LoopEnd v x -> Bool
$c/= :: forall v x. (Eq x, Eq v) => LoopEnd v x -> LoopEnd v x -> Bool
/= :: LoopEnd v x -> LoopEnd v x -> Bool
Eq)
instance (Var v, Show x) => Show (LoopEnd v x) where show :: LoopEnd v x -> String
show = LoopEnd v x -> String
forall a. Label a => a -> String
label
instance Var v => Label (LoopEnd v x) where
    label :: LoopEnd v x -> String
label (LoopEnd (Loop X x
_ O v
os I v
_) I v
i) = String
"LoopEnd(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> I v -> String
forall a. Show a => a -> String
show I v
i String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
") pair out: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> O v -> String
forall a. Show a => a -> String
show O v
os
instance Var v => Function (LoopEnd v x) v where
    inputs :: LoopEnd v x -> Set v
inputs (LoopEnd Loop v x
_ I v
o) = I v -> Set v
forall a v. Variables a v => a -> Set v
variables I v
o
    isInternalLockPossible :: LoopEnd v x -> Bool
isInternalLockPossible LoopEnd v x
_ = Bool
True
instance Var v => Patch (LoopEnd v x) (v, v) where
    patch :: (v, v) -> LoopEnd v x -> LoopEnd v x
patch (v, v)
diff (LoopEnd Loop v x
l I v
a) = Loop v x -> I v -> LoopEnd v x
forall v x. Loop v x -> I v -> LoopEnd v x
LoopEnd ((v, v) -> Loop v x -> Loop v x
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff Loop v x
l) (I v -> LoopEnd v x) -> I v -> LoopEnd v x
forall a b. (a -> b) -> a -> b
$ (v, v) -> I v -> I v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff I v
a
instance Var v => Locks (LoopEnd v x) v where locks :: LoopEnd v x -> [Lock v]
locks (LoopEnd Loop v x
l I v
_) = Loop v x -> [Lock v]
forall x v. Locks x v => x -> [Lock v]
locks Loop v x
l
instance Var v => FunctionSimulation (LoopEnd v x) v x where
    simulate :: CycleCntx v x -> LoopEnd v x -> [(v, x)]
simulate CycleCntx v x
cntx (LoopEnd Loop v x
l I v
_) = CycleCntx v x -> Loop v x -> [(v, x)]
forall f v x.
FunctionSimulation f v x =>
CycleCntx v x -> f -> [(v, x)]
simulate CycleCntx v x
cntx Loop v x
l

data Buffer v x = Buffer (I v) (O v) deriving (Typeable, Buffer v x -> Buffer v x -> Bool
(Buffer v x -> Buffer v x -> Bool)
-> (Buffer v x -> Buffer v x -> Bool) -> Eq (Buffer v x)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v x. Eq v => Buffer v x -> Buffer v x -> Bool
$c== :: forall v x. Eq v => Buffer v x -> Buffer v x -> Bool
== :: Buffer v x -> Buffer v x -> Bool
$c/= :: forall v x. Eq v => Buffer v x -> Buffer v x -> Bool
/= :: Buffer v x -> Buffer v x -> Bool
Eq)
instance Label (Buffer v x) where label :: Buffer v x -> String
label Buffer{} = String
"buf"
instance Var v => Show (Buffer v x) where
    show :: Buffer v x -> String
show (Buffer I v
i O v
os) = String
"buffer(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> I v -> String
forall a. Show a => a -> String
show I v
i String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> O v -> String
forall a. Show a => a -> String
show O v
os
buffer :: (Var v, Val x) => v -> [v] -> F v x
buffer :: forall v x. (Var v, Val x) => v -> [v] -> F v x
buffer v
a [v]
b = Buffer v x -> F v x
forall {f} {v} {x}.
(Function f v, Patch f (v, v), Locks f v, Show f, Label f,
 FunctionSimulation f v x, Typeable f, Eq f) =>
f -> F v x
packF (Buffer v x -> F v x) -> Buffer v x -> F v x
forall a b. (a -> b) -> a -> b
$ I v -> O v -> Buffer v x
forall v x. I v -> O v -> Buffer v x
Buffer (v -> I v
forall v. v -> I v
I v
a) (Set v -> O v
forall v. Set v -> O v
O (Set v -> O v) -> Set v -> O v
forall a b. (a -> b) -> a -> b
$ [v] -> Set v
forall a. Ord a => [a] -> Set a
S.fromList [v]
b)

instance Var v => Function (Buffer v x) v where
    inputs :: Buffer v x -> Set v
inputs (Buffer I v
a O v
_b) = I v -> Set v
forall a v. Variables a v => a -> Set v
variables I v
a
    outputs :: Buffer v x -> Set v
outputs (Buffer I v
_a O v
b) = O v -> Set v
forall a v. Variables a v => a -> Set v
variables O v
b
instance Var v => Patch (Buffer v x) (v, v) where
    patch :: (v, v) -> Buffer v x -> Buffer v x
patch (v, v)
diff (Buffer I v
a O v
b) = I v -> O v -> Buffer v x
forall v x. I v -> O v -> Buffer v x
Buffer ((v, v) -> I v -> I v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff I v
a) ((v, v) -> O v -> O v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff O v
b)
instance Var v => Locks (Buffer v x) v where
    locks :: Buffer v x -> [Lock v]
locks = Buffer v x -> [Lock v]
forall {f} {v}. Function f v => f -> [Lock v]
inputsLockOutputs
instance Var v => FunctionSimulation (Buffer v x) v x where
    simulate :: CycleCntx v x -> Buffer v x -> [(v, x)]
simulate CycleCntx v x
cntx (Buffer (I v
a) (O Set v
vs)) =
        [(v
v, CycleCntx v x
cntx CycleCntx v x -> v -> x
forall {a} {v}. (Hashable a, ToString a) => CycleCntx a v -> a -> v
`getCntx` v
a) | v
v <- Set v -> [v]
forall a. Set a -> [a]
S.elems Set v
vs]

data Add v x = Add (I v) (I v) (O v) deriving (Typeable, Add v x -> Add v x -> Bool
(Add v x -> Add v x -> Bool)
-> (Add v x -> Add v x -> Bool) -> Eq (Add v x)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v x. Eq v => Add v x -> Add v x -> Bool
$c== :: forall v x. Eq v => Add v x -> Add v x -> Bool
== :: Add v x -> Add v x -> Bool
$c/= :: forall v x. Eq v => Add v x -> Add v x -> Bool
/= :: Add v x -> Add v x -> Bool
Eq)
instance Label (Add v x) where label :: Add v x -> String
label Add{} = String
"+"
instance Var v => Show (Add v x) where
    show :: Add v x -> String
show (Add I v
a I v
b O v
c) =
        let lexp :: String
lexp = I v -> String
forall a. Show a => a -> String
show I v
a String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" + " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> I v -> String
forall a. Show a => a -> String
show I v
b
            rexp :: String
rexp = O v -> String
forall a. Show a => a -> String
show O v
c
         in String
lexp String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
rexp
add :: (Var v, Val x) => v -> v -> [v] -> F v x
add :: forall v x. (Var v, Val x) => v -> v -> [v] -> F v x
add v
a v
b [v]
c = Add v x -> F v x
forall {f} {v} {x}.
(Function f v, Patch f (v, v), Locks f v, Show f, Label f,
 FunctionSimulation f v x, Typeable f, Eq f) =>
f -> F v x
packF (Add v x -> F v x) -> Add v x -> F v x
forall a b. (a -> b) -> a -> b
$ I v -> I v -> O v -> Add v x
forall v x. I v -> I v -> O v -> Add v x
Add (v -> I v
forall v. v -> I v
I v
a) (v -> I v
forall v. v -> I v
I v
b) (O v -> Add v x) -> O v -> Add v x
forall a b. (a -> b) -> a -> b
$ Set v -> O v
forall v. Set v -> O v
O (Set v -> O v) -> Set v -> O v
forall a b. (a -> b) -> a -> b
$ [v] -> Set v
forall a. Ord a => [a] -> Set a
S.fromList [v]
c

instance Var v => Function (Add v x) v where
    inputs :: Add v x -> Set v
inputs (Add I v
a I v
b O v
_c) = I v -> Set v
forall a v. Variables a v => a -> Set v
variables I v
a Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
`S.union` I v -> Set v
forall a v. Variables a v => a -> Set v
variables I v
b
    outputs :: Add v x -> Set v
outputs (Add I v
_a I v
_b O v
c) = O v -> Set v
forall a v. Variables a v => a -> Set v
variables O v
c
instance Var v => Patch (Add v x) (v, v) where
    patch :: (v, v) -> Add v x -> Add v x
patch (v, v)
diff (Add I v
a I v
b O v
c) = I v -> I v -> O v -> Add v x
forall v x. I v -> I v -> O v -> Add v x
Add ((v, v) -> I v -> I v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff I v
a) ((v, v) -> I v -> I v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff I v
b) ((v, v) -> O v -> O v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff O v
c)
instance Var v => Locks (Add v x) v where
    locks :: Add v x -> [Lock v]
locks = Add v x -> [Lock v]
forall {f} {v}. Function f v => f -> [Lock v]
inputsLockOutputs
instance (Var v, Num x) => FunctionSimulation (Add v x) v x where
    simulate :: CycleCntx v x -> Add v x -> [(v, x)]
simulate CycleCntx v x
cntx (Add (I v
v1) (I v
v2) (O Set v
vs)) =
        let x1 :: x
x1 = CycleCntx v x
cntx CycleCntx v x -> v -> x
forall {a} {v}. (Hashable a, ToString a) => CycleCntx a v -> a -> v
`getCntx` v
v1
            x2 :: x
x2 = CycleCntx v x
cntx CycleCntx v x -> v -> x
forall {a} {v}. (Hashable a, ToString a) => CycleCntx a v -> a -> v
`getCntx` v
v2
            y :: x
y = x
x1 x -> x -> x
forall a. Num a => a -> a -> a
+ x
x2
         in [(v
v, x
y) | v
v <- Set v -> [v]
forall a. Set a -> [a]
S.elems Set v
vs]

data Sub v x = Sub (I v) (I v) (O v) deriving (Typeable, Sub v x -> Sub v x -> Bool
(Sub v x -> Sub v x -> Bool)
-> (Sub v x -> Sub v x -> Bool) -> Eq (Sub v x)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v x. Eq v => Sub v x -> Sub v x -> Bool
$c== :: forall v x. Eq v => Sub v x -> Sub v x -> Bool
== :: Sub v x -> Sub v x -> Bool
$c/= :: forall v x. Eq v => Sub v x -> Sub v x -> Bool
/= :: Sub v x -> Sub v x -> Bool
Eq)
instance Label (Sub v x) where label :: Sub v x -> String
label Sub{} = String
"-"
instance Var v => Show (Sub v x) where
    show :: Sub v x -> String
show (Sub I v
a I v
b O v
c) =
        let lexp :: String
lexp = I v -> String
forall a. Show a => a -> String
show I v
a String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" - " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> I v -> String
forall a. Show a => a -> String
show I v
b
            rexp :: String
rexp = O v -> String
forall a. Show a => a -> String
show O v
c
         in String
lexp String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
rexp
sub :: (Var v, Val x) => v -> v -> [v] -> F v x
sub :: forall v x. (Var v, Val x) => v -> v -> [v] -> F v x
sub v
a v
b [v]
c = Sub v x -> F v x
forall {f} {v} {x}.
(Function f v, Patch f (v, v), Locks f v, Show f, Label f,
 FunctionSimulation f v x, Typeable f, Eq f) =>
f -> F v x
packF (Sub v x -> F v x) -> Sub v x -> F v x
forall a b. (a -> b) -> a -> b
$ I v -> I v -> O v -> Sub v x
forall v x. I v -> I v -> O v -> Sub v x
Sub (v -> I v
forall v. v -> I v
I v
a) (v -> I v
forall v. v -> I v
I v
b) (O v -> Sub v x) -> O v -> Sub v x
forall a b. (a -> b) -> a -> b
$ Set v -> O v
forall v. Set v -> O v
O (Set v -> O v) -> Set v -> O v
forall a b. (a -> b) -> a -> b
$ [v] -> Set v
forall a. Ord a => [a] -> Set a
S.fromList [v]
c

instance Var v => Function (Sub v x) v where
    inputs :: Sub v x -> Set v
inputs (Sub I v
a I v
b O v
_c) = I v -> Set v
forall a v. Variables a v => a -> Set v
variables I v
a Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
`S.union` I v -> Set v
forall a v. Variables a v => a -> Set v
variables I v
b
    outputs :: Sub v x -> Set v
outputs (Sub I v
_a I v
_b O v
c) = O v -> Set v
forall a v. Variables a v => a -> Set v
variables O v
c
instance Var v => Patch (Sub v x) (v, v) where
    patch :: (v, v) -> Sub v x -> Sub v x
patch (v, v)
diff (Sub I v
a I v
b O v
c) = I v -> I v -> O v -> Sub v x
forall v x. I v -> I v -> O v -> Sub v x
Sub ((v, v) -> I v -> I v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff I v
a) ((v, v) -> I v -> I v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff I v
b) ((v, v) -> O v -> O v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff O v
c)
instance Var v => Locks (Sub v x) v where
    locks :: Sub v x -> [Lock v]
locks = Sub v x -> [Lock v]
forall {f} {v}. Function f v => f -> [Lock v]
inputsLockOutputs
instance (Var v, Num x) => FunctionSimulation (Sub v x) v x where
    simulate :: CycleCntx v x -> Sub v x -> [(v, x)]
simulate CycleCntx v x
cntx (Sub (I v
v1) (I v
v2) (O Set v
vs)) =
        let x1 :: x
x1 = CycleCntx v x
cntx CycleCntx v x -> v -> x
forall {a} {v}. (Hashable a, ToString a) => CycleCntx a v -> a -> v
`getCntx` v
v1
            x2 :: x
x2 = CycleCntx v x
cntx CycleCntx v x -> v -> x
forall {a} {v}. (Hashable a, ToString a) => CycleCntx a v -> a -> v
`getCntx` v
v2
            y :: x
y = x
x1 x -> x -> x
forall a. Num a => a -> a -> a
- x
x2
         in [(v
v, x
y) | v
v <- Set v -> [v]
forall a. Set a -> [a]
S.elems Set v
vs]

data Multiply v x = Multiply (I v) (I v) (O v) deriving (Typeable, Multiply v x -> Multiply v x -> Bool
(Multiply v x -> Multiply v x -> Bool)
-> (Multiply v x -> Multiply v x -> Bool) -> Eq (Multiply v x)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v x. Eq v => Multiply v x -> Multiply v x -> Bool
$c== :: forall v x. Eq v => Multiply v x -> Multiply v x -> Bool
== :: Multiply v x -> Multiply v x -> Bool
$c/= :: forall v x. Eq v => Multiply v x -> Multiply v x -> Bool
/= :: Multiply v x -> Multiply v x -> Bool
Eq)
instance Label (Multiply v x) where label :: Multiply v x -> String
label Multiply{} = String
"*"
instance Var v => Show (Multiply v x) where
    show :: Multiply v x -> String
show (Multiply I v
a I v
b O v
c) =
        I v -> String
forall a. Show a => a -> String
show I v
a String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" * " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> I v -> String
forall a. Show a => a -> String
show I v
b String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> O v -> String
forall a. Show a => a -> String
show O v
c
multiply :: (Var v, Val x) => v -> v -> [v] -> F v x
multiply :: forall v x. (Var v, Val x) => v -> v -> [v] -> F v x
multiply v
a v
b [v]
c = Multiply v x -> F v x
forall {f} {v} {x}.
(Function f v, Patch f (v, v), Locks f v, Show f, Label f,
 FunctionSimulation f v x, Typeable f, Eq f) =>
f -> F v x
packF (Multiply v x -> F v x) -> Multiply v x -> F v x
forall a b. (a -> b) -> a -> b
$ I v -> I v -> O v -> Multiply v x
forall v x. I v -> I v -> O v -> Multiply v x
Multiply (v -> I v
forall v. v -> I v
I v
a) (v -> I v
forall v. v -> I v
I v
b) (O v -> Multiply v x) -> O v -> Multiply v x
forall a b. (a -> b) -> a -> b
$ Set v -> O v
forall v. Set v -> O v
O (Set v -> O v) -> Set v -> O v
forall a b. (a -> b) -> a -> b
$ [v] -> Set v
forall a. Ord a => [a] -> Set a
S.fromList [v]
c

instance Var v => Function (Multiply v x) v where
    inputs :: Multiply v x -> Set v
inputs (Multiply I v
a I v
b O v
_c) = I v -> Set v
forall a v. Variables a v => a -> Set v
variables I v
a Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
`S.union` I v -> Set v
forall a v. Variables a v => a -> Set v
variables I v
b
    outputs :: Multiply v x -> Set v
outputs (Multiply I v
_a I v
_b O v
c) = O v -> Set v
forall a v. Variables a v => a -> Set v
variables O v
c
instance Var v => Patch (Multiply v x) (v, v) where
    patch :: (v, v) -> Multiply v x -> Multiply v x
patch (v, v)
diff (Multiply I v
a I v
b O v
c) = I v -> I v -> O v -> Multiply v x
forall v x. I v -> I v -> O v -> Multiply v x
Multiply ((v, v) -> I v -> I v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff I v
a) ((v, v) -> I v -> I v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff I v
b) ((v, v) -> O v -> O v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff O v
c)
instance Var v => Locks (Multiply v x) v where
    locks :: Multiply v x -> [Lock v]
locks = Multiply v x -> [Lock v]
forall {f} {v}. Function f v => f -> [Lock v]
inputsLockOutputs
instance (Var v, Num x) => FunctionSimulation (Multiply v x) v x where
    simulate :: CycleCntx v x -> Multiply v x -> [(v, x)]
simulate CycleCntx v x
cntx (Multiply (I v
v1) (I v
v2) (O Set v
vs)) =
        let x1 :: x
x1 = CycleCntx v x
cntx CycleCntx v x -> v -> x
forall {a} {v}. (Hashable a, ToString a) => CycleCntx a v -> a -> v
`getCntx` v
v1
            x2 :: x
x2 = CycleCntx v x
cntx CycleCntx v x -> v -> x
forall {a} {v}. (Hashable a, ToString a) => CycleCntx a v -> a -> v
`getCntx` v
v2
            y :: x
y = x
x1 x -> x -> x
forall a. Num a => a -> a -> a
* x
x2
         in [(v
v, x
y) | v
v <- Set v -> [v]
forall a. Set a -> [a]
S.elems Set v
vs]

data Division v x = Division
    { forall v x. Division v x -> I v
denom, forall v x. Division v x -> I v
numer :: I v
    , forall v x. Division v x -> O v
quotient, forall v x. Division v x -> O v
remain :: O v
    }
    deriving (Typeable, Division v x -> Division v x -> Bool
(Division v x -> Division v x -> Bool)
-> (Division v x -> Division v x -> Bool) -> Eq (Division v x)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v x. Eq v => Division v x -> Division v x -> Bool
$c== :: forall v x. Eq v => Division v x -> Division v x -> Bool
== :: Division v x -> Division v x -> Bool
$c/= :: forall v x. Eq v => Division v x -> Division v x -> Bool
/= :: Division v x -> Division v x -> Bool
Eq)
instance Label (Division v x) where label :: Division v x -> String
label Division{} = String
"/"
instance Var v => Show (Division v x) where
    show :: Division v x -> String
show Division{I v
denom :: forall v x. Division v x -> I v
denom :: I v
denom, I v
numer :: forall v x. Division v x -> I v
numer :: I v
numer, O v
quotient :: forall v x. Division v x -> O v
quotient :: O v
quotient, O v
remain :: forall v x. Division v x -> O v
remain :: O v
remain} =
        let q :: String
q = I v -> String
forall a. Show a => a -> String
show I v
numer String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" / " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> I v -> String
forall a. Show a => a -> String
show I v
denom String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> O v -> String
forall a. Show a => a -> String
show O v
quotient
            r :: String
r = I v -> String
forall a. Show a => a -> String
show I v
numer String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" mod " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> I v -> String
forall a. Show a => a -> String
show I v
denom String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> O v -> String
forall a. Show a => a -> String
show O v
remain
         in String
q String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"; " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
r
division :: (Var v, Val x) => v -> v -> [v] -> [v] -> F v x
division :: forall v x. (Var v, Val x) => v -> v -> [v] -> [v] -> F v x
division v
d v
n [v]
q [v]
r =
    Division v x -> F v x
forall {f} {v} {x}.
(Function f v, Patch f (v, v), Locks f v, Show f, Label f,
 FunctionSimulation f v x, Typeable f, Eq f) =>
f -> F v x
packF (Division v x -> F v x) -> Division v x -> F v x
forall a b. (a -> b) -> a -> b
$
        Division
            { denom :: I v
denom = v -> I v
forall v. v -> I v
I v
d
            , numer :: I v
numer = v -> I v
forall v. v -> I v
I v
n
            , quotient :: O v
quotient = Set v -> O v
forall v. Set v -> O v
O (Set v -> O v) -> Set v -> O v
forall a b. (a -> b) -> a -> b
$ [v] -> Set v
forall a. Ord a => [a] -> Set a
S.fromList [v]
q
            , remain :: O v
remain = Set v -> O v
forall v. Set v -> O v
O (Set v -> O v) -> Set v -> O v
forall a b. (a -> b) -> a -> b
$ [v] -> Set v
forall a. Ord a => [a] -> Set a
S.fromList [v]
r
            }

instance Var v => Function (Division v x) v where
    inputs :: Division v x -> Set v
inputs Division{I v
denom :: forall v x. Division v x -> I v
denom :: I v
denom, I v
numer :: forall v x. Division v x -> I v
numer :: I v
numer} = I v -> Set v
forall a v. Variables a v => a -> Set v
variables I v
denom Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
`S.union` I v -> Set v
forall a v. Variables a v => a -> Set v
variables I v
numer
    outputs :: Division v x -> Set v
outputs Division{O v
quotient :: forall v x. Division v x -> O v
quotient :: O v
quotient, O v
remain :: forall v x. Division v x -> O v
remain :: O v
remain} = O v -> Set v
forall a v. Variables a v => a -> Set v
variables O v
quotient Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
`S.union` O v -> Set v
forall a v. Variables a v => a -> Set v
variables O v
remain
instance Var v => Patch (Division v x) (v, v) where
    patch :: (v, v) -> Division v x -> Division v x
patch (v, v)
diff (Division I v
a I v
b O v
c O v
d) = I v -> I v -> O v -> O v -> Division v x
forall v x. I v -> I v -> O v -> O v -> Division v x
Division ((v, v) -> I v -> I v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff I v
a) ((v, v) -> I v -> I v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff I v
b) ((v, v) -> O v -> O v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff O v
c) ((v, v) -> O v -> O v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff O v
d)
instance Var v => Locks (Division v x) v where
    locks :: Division v x -> [Lock v]
locks = Division v x -> [Lock v]
forall {f} {v}. Function f v => f -> [Lock v]
inputsLockOutputs
instance (Var v, Val x) => FunctionSimulation (Division v x) v x where
    simulate :: CycleCntx v x -> Division v x -> [(v, x)]
simulate CycleCntx v x
cntx Division{denom :: forall v x. Division v x -> I v
denom = I v
d, numer :: forall v x. Division v x -> I v
numer = I v
n, quotient :: forall v x. Division v x -> O v
quotient = O Set v
qs, remain :: forall v x. Division v x -> O v
remain = O Set v
rs} =
        let dx :: x
dx = CycleCntx v x
cntx CycleCntx v x -> v -> x
forall {a} {v}. (Hashable a, ToString a) => CycleCntx a v -> a -> v
`getCntx` v
d
            nx :: x
nx = CycleCntx v x
cntx CycleCntx v x -> v -> x
forall {a} {v}. (Hashable a, ToString a) => CycleCntx a v -> a -> v
`getCntx` v
n
            qx :: x
qx = Integer -> Integer -> x
forall x. Val x => Integer -> Integer -> x
fromRaw (x -> Integer
forall x. Val x => x -> Integer
rawData x
dx Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
2 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ x -> Integer
forall a. FixedPointCompatible a => a -> Integer
scalingFactorPower x
dx Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` x -> Integer
forall x. Val x => x -> Integer
rawData x
nx) Integer
forall a. Default a => a
def
            rx :: x
rx = x
dx x -> x -> x
forall a. Integral a => a -> a -> a
`mod` x
nx
         in [(v
v, x
qx) | v
v <- Set v -> [v]
forall a. Set a -> [a]
S.elems Set v
qs] [(v, x)] -> [(v, x)] -> [(v, x)]
forall a. [a] -> [a] -> [a]
++ [(v
v, x
rx) | v
v <- Set v -> [v]
forall a. Set a -> [a]
S.elems Set v
rs]

data Neg v x = Neg (I v) (O v) deriving (Typeable, Neg v x -> Neg v x -> Bool
(Neg v x -> Neg v x -> Bool)
-> (Neg v x -> Neg v x -> Bool) -> Eq (Neg v x)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v x. Eq v => Neg v x -> Neg v x -> Bool
$c== :: forall v x. Eq v => Neg v x -> Neg v x -> Bool
== :: Neg v x -> Neg v x -> Bool
$c/= :: forall v x. Eq v => Neg v x -> Neg v x -> Bool
/= :: Neg v x -> Neg v x -> Bool
Eq)
instance Label (Neg v x) where label :: Neg v x -> String
label Neg{} = String
"neg"
instance Var v => Show (Neg v x) where
    show :: Neg v x -> String
show (Neg I v
i O v
o) = String
"-" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> I v -> String
forall a. Show a => a -> String
show I v
i String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> O v -> String
forall a. Show a => a -> String
show O v
o

neg :: (Var v, Val x) => v -> [v] -> F v x
neg :: forall v x. (Var v, Val x) => v -> [v] -> F v x
neg v
i [v]
o = Neg v x -> F v x
forall {f} {v} {x}.
(Function f v, Patch f (v, v), Locks f v, Show f, Label f,
 FunctionSimulation f v x, Typeable f, Eq f) =>
f -> F v x
packF (Neg v x -> F v x) -> Neg v x -> F v x
forall a b. (a -> b) -> a -> b
$ I v -> O v -> Neg v x
forall v x. I v -> O v -> Neg v x
Neg (v -> I v
forall v. v -> I v
I v
i) (O v -> Neg v x) -> O v -> Neg v x
forall a b. (a -> b) -> a -> b
$ Set v -> O v
forall v. Set v -> O v
O (Set v -> O v) -> Set v -> O v
forall a b. (a -> b) -> a -> b
$ [v] -> Set v
forall a. Ord a => [a] -> Set a
S.fromList [v]
o

instance Ord v => Function (Neg v x) v where
    inputs :: Neg v x -> Set v
inputs (Neg I v
i O v
_) = I v -> Set v
forall a v. Variables a v => a -> Set v
variables I v
i
    outputs :: Neg v x -> Set v
outputs (Neg I v
_ O v
o) = O v -> Set v
forall a v. Variables a v => a -> Set v
variables O v
o
instance Ord v => Patch (Neg v x) (v, v) where
    patch :: (v, v) -> Neg v x -> Neg v x
patch (v, v)
diff (Neg I v
i O v
o) = I v -> O v -> Neg v x
forall v x. I v -> O v -> Neg v x
Neg ((v, v) -> I v -> I v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff I v
i) ((v, v) -> O v -> O v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff O v
o)
instance Var v => Locks (Neg v x) v where
    locks :: Neg v x -> [Lock v]
locks = Neg v x -> [Lock v]
forall {f} {v}. Function f v => f -> [Lock v]
inputsLockOutputs
instance (Var v, Num x) => FunctionSimulation (Neg v x) v x where
    simulate :: CycleCntx v x -> Neg v x -> [(v, x)]
simulate CycleCntx v x
cntx (Neg (I v
i) (O Set v
o)) =
        let x1 :: x
x1 = CycleCntx v x
cntx CycleCntx v x -> v -> x
forall {a} {v}. (Hashable a, ToString a) => CycleCntx a v -> a -> v
`getCntx` v
i
            y :: x
y = -x
x1
         in [(v
v, x
y) | v
v <- Set v -> [v]
forall a. Set a -> [a]
S.elems Set v
o]

data Constant v x = Constant (X x) (O v) deriving (Typeable, Constant v x -> Constant v x -> Bool
(Constant v x -> Constant v x -> Bool)
-> (Constant v x -> Constant v x -> Bool) -> Eq (Constant v x)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v x. (Eq x, Eq v) => Constant v x -> Constant v x -> Bool
$c== :: forall v x. (Eq x, Eq v) => Constant v x -> Constant v x -> Bool
== :: Constant v x -> Constant v x -> Bool
$c/= :: forall v x. (Eq x, Eq v) => Constant v x -> Constant v x -> Bool
/= :: Constant v x -> Constant v x -> Bool
Eq)
instance Show x => Label (Constant v x) where label :: Constant v x -> String
label (Constant (X x
x) O v
_) = x -> String
forall a. Show a => a -> String
show x
x
instance (Var v, Show x) => Show (Constant v x) where
    show :: Constant v x -> String
show (Constant (X x
x) O v
os) = String
"const(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> x -> String
forall a. Show a => a -> String
show x
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
") = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> O v -> String
forall a. Show a => a -> String
show O v
os
constant :: (Var v, Val x) => x -> [v] -> F v x
constant :: forall v x. (Var v, Val x) => x -> [v] -> F v x
constant x
x [v]
vs = Constant v x -> F v x
forall {f} {v} {x}.
(Function f v, Patch f (v, v), Locks f v, Show f, Label f,
 FunctionSimulation f v x, Typeable f, Eq f) =>
f -> F v x
packF (Constant v x -> F v x) -> Constant v x -> F v x
forall a b. (a -> b) -> a -> b
$ X x -> O v -> Constant v x
forall v x. X x -> O v -> Constant v x
Constant (x -> X x
forall x. x -> X x
X x
x) (O v -> Constant v x) -> O v -> Constant v x
forall a b. (a -> b) -> a -> b
$ Set v -> O v
forall v. Set v -> O v
O (Set v -> O v) -> Set v -> O v
forall a b. (a -> b) -> a -> b
$ [v] -> Set v
forall a. Ord a => [a] -> Set a
S.fromList [v]
vs
isConst :: F v x -> Bool
isConst F v x
f
    | Just Constant{} <- F v x -> Maybe (Constant v x)
forall (f :: * -> * -> *) v x.
(Typeable f, Typeable v, Typeable x) =>
F v x -> Maybe (f v x)
castF F v x
f = Bool
True
    | Bool
otherwise = Bool
False

instance (Show x, Eq x, Typeable x) => Function (Constant v x) v where
    outputs :: Constant v x -> Set v
outputs (Constant X x
_ O v
o) = O v -> Set v
forall a v. Variables a v => a -> Set v
variables O v
o
instance Var v => Patch (Constant v x) (v, v) where
    patch :: (v, v) -> Constant v x -> Constant v x
patch (v, v)
diff (Constant X x
x O v
a) = X x -> O v -> Constant v x
forall v x. X x -> O v -> Constant v x
Constant X x
x ((v, v) -> O v -> O v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff O v
a)
instance Var v => Locks (Constant v x) v where locks :: Constant v x -> [Lock v]
locks Constant v x
_ = []
instance FunctionSimulation (Constant v x) v x where
    simulate :: CycleCntx v x -> Constant v x -> [(v, x)]
simulate CycleCntx v x
_cntx (Constant (X x
x) (O Set v
vs)) = [(v
v, x
x) | v
v <- Set v -> [v]
forall a. Set a -> [a]
S.elems Set v
vs]

-- TODO: separete into two different functions

-- | Functional unit that implements logic shift operations
data ShiftLR v x
    = ShiftL Int (I v) (O v)
    | ShiftR Int (I v) (O v)
    deriving (Typeable, ShiftLR v x -> ShiftLR v x -> Bool
(ShiftLR v x -> ShiftLR v x -> Bool)
-> (ShiftLR v x -> ShiftLR v x -> Bool) -> Eq (ShiftLR v x)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v x. Eq v => ShiftLR v x -> ShiftLR v x -> Bool
$c== :: forall v x. Eq v => ShiftLR v x -> ShiftLR v x -> Bool
== :: ShiftLR v x -> ShiftLR v x -> Bool
$c/= :: forall v x. Eq v => ShiftLR v x -> ShiftLR v x -> Bool
/= :: ShiftLR v x -> ShiftLR v x -> Bool
Eq)

instance Var v => Show (ShiftLR v x) where
    show :: ShiftLR v x -> String
show (ShiftL Int
s I v
i O v
os) = I v -> String
forall a. Show a => a -> String
show I v
i String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" << " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> O v -> String
forall a. Show a => a -> String
show O v
os
    show (ShiftR Int
s I v
i O v
os) = I v -> String
forall a. Show a => a -> String
show I v
i String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" >> " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> O v -> String
forall a. Show a => a -> String
show O v
os
instance Var v => Label (ShiftLR v x) where label :: ShiftLR v x -> String
label = ShiftLR v x -> String
forall a. Show a => a -> String
show

shiftL :: (Var v, Val x) => Int -> v -> [v] -> F v x
shiftL :: forall v x. (Var v, Val x) => Int -> v -> [v] -> F v x
shiftL Int
s v
i [v]
o = ShiftLR v x -> F v x
forall {f} {v} {x}.
(Function f v, Patch f (v, v), Locks f v, Show f, Label f,
 FunctionSimulation f v x, Typeable f, Eq f) =>
f -> F v x
packF (ShiftLR v x -> F v x) -> ShiftLR v x -> F v x
forall a b. (a -> b) -> a -> b
$ Int -> I v -> O v -> ShiftLR v x
forall v x. Int -> I v -> O v -> ShiftLR v x
ShiftL Int
s (v -> I v
forall v. v -> I v
I v
i) (O v -> ShiftLR v x) -> O v -> ShiftLR v x
forall a b. (a -> b) -> a -> b
$ Set v -> O v
forall v. Set v -> O v
O (Set v -> O v) -> Set v -> O v
forall a b. (a -> b) -> a -> b
$ [v] -> Set v
forall a. Ord a => [a] -> Set a
S.fromList [v]
o
shiftR :: (Var v, Val x) => Int -> v -> [v] -> F v x
shiftR :: forall v x. (Var v, Val x) => Int -> v -> [v] -> F v x
shiftR Int
s v
i [v]
o = ShiftLR v x -> F v x
forall {f} {v} {x}.
(Function f v, Patch f (v, v), Locks f v, Show f, Label f,
 FunctionSimulation f v x, Typeable f, Eq f) =>
f -> F v x
packF (ShiftLR v x -> F v x) -> ShiftLR v x -> F v x
forall a b. (a -> b) -> a -> b
$ Int -> I v -> O v -> ShiftLR v x
forall v x. Int -> I v -> O v -> ShiftLR v x
ShiftR Int
s (v -> I v
forall v. v -> I v
I v
i) (O v -> ShiftLR v x) -> O v -> ShiftLR v x
forall a b. (a -> b) -> a -> b
$ Set v -> O v
forall v. Set v -> O v
O (Set v -> O v) -> Set v -> O v
forall a b. (a -> b) -> a -> b
$ [v] -> Set v
forall a. Ord a => [a] -> Set a
S.fromList [v]
o

instance Var v => Function (ShiftLR v x) v where
    inputs :: ShiftLR v x -> Set v
inputs (ShiftL Int
_ I v
i O v
_) = I v -> Set v
forall a v. Variables a v => a -> Set v
variables I v
i
    inputs (ShiftR Int
_ I v
i O v
_) = I v -> Set v
forall a v. Variables a v => a -> Set v
variables I v
i
    outputs :: ShiftLR v x -> Set v
outputs (ShiftL Int
_ I v
_ O v
o) = O v -> Set v
forall a v. Variables a v => a -> Set v
variables O v
o
    outputs (ShiftR Int
_ I v
_ O v
o) = O v -> Set v
forall a v. Variables a v => a -> Set v
variables O v
o
instance Var v => Patch (ShiftLR v x) (v, v) where
    patch :: (v, v) -> ShiftLR v x -> ShiftLR v x
patch (v, v)
diff (ShiftL Int
s I v
i O v
o) = Int -> I v -> O v -> ShiftLR v x
forall v x. Int -> I v -> O v -> ShiftLR v x
ShiftL Int
s ((v, v) -> I v -> I v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff I v
i) ((v, v) -> O v -> O v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff O v
o)
    patch (v, v)
diff (ShiftR Int
s I v
i O v
o) = Int -> I v -> O v -> ShiftLR v x
forall v x. Int -> I v -> O v -> ShiftLR v x
ShiftR Int
s ((v, v) -> I v -> I v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff I v
i) ((v, v) -> O v -> O v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff O v
o)
instance Var v => Locks (ShiftLR v x) v where
    locks :: ShiftLR v x -> [Lock v]
locks = ShiftLR v x -> [Lock v]
forall {f} {v}. Function f v => f -> [Lock v]
inputsLockOutputs
instance (Var v, B.Bits x) => FunctionSimulation (ShiftLR v x) v x where
    simulate :: CycleCntx v x -> ShiftLR v x -> [(v, x)]
simulate CycleCntx v x
cntx (ShiftL Int
s (I v
i) (O Set v
os)) = do
        [(v
o, CycleCntx v x -> v -> x
forall {a} {v}. (Hashable a, ToString a) => CycleCntx a v -> a -> v
getCntx CycleCntx v x
cntx v
i x -> Int -> x
forall a. Bits a => a -> Int -> a
`B.shiftL` Int
s) | v
o <- Set v -> [v]
forall a. Set a -> [a]
S.elems Set v
os]
    simulate CycleCntx v x
cntx (ShiftR Int
s (I v
i) (O Set v
os)) = do
        [(v
o, CycleCntx v x -> v -> x
forall {a} {v}. (Hashable a, ToString a) => CycleCntx a v -> a -> v
getCntx CycleCntx v x
cntx v
i x -> Int -> x
forall a. Bits a => a -> Int -> a
`B.shiftR` Int
s) | v
o <- Set v -> [v]
forall a. Set a -> [a]
S.elems Set v
os]

newtype Send v x = Send (I v) deriving (Typeable, Send v x -> Send v x -> Bool
(Send v x -> Send v x -> Bool)
-> (Send v x -> Send v x -> Bool) -> Eq (Send v x)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v x. Eq v => Send v x -> Send v x -> Bool
$c== :: forall v x. Eq v => Send v x -> Send v x -> Bool
== :: Send v x -> Send v x -> Bool
$c/= :: forall v x. Eq v => Send v x -> Send v x -> Bool
/= :: Send v x -> Send v x -> Bool
Eq)
instance Var v => Show (Send v x) where
    show :: Send v x -> String
show (Send I v
i) = String
"send(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> I v -> String
forall a. Show a => a -> String
show I v
i String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
instance Label (Send v x) where label :: Send v x -> String
label Send{} = String
"send"
send :: (Var v, Val x) => v -> F v x
send :: forall v x. (Var v, Val x) => v -> F v x
send v
a = Send v x -> F v x
forall {f} {v} {x}.
(Function f v, Patch f (v, v), Locks f v, Show f, Label f,
 FunctionSimulation f v x, Typeable f, Eq f) =>
f -> F v x
packF (Send v x -> F v x) -> Send v x -> F v x
forall a b. (a -> b) -> a -> b
$ I v -> Send v x
forall v x. I v -> Send v x
Send (I v -> Send v x) -> I v -> Send v x
forall a b. (a -> b) -> a -> b
$ v -> I v
forall v. v -> I v
I v
a
instance Var v => Function (Send v x) v where
    inputs :: Send v x -> Set v
inputs (Send I v
i) = I v -> Set v
forall a v. Variables a v => a -> Set v
variables I v
i
instance Var v => Patch (Send v x) (v, v) where
    patch :: (v, v) -> Send v x -> Send v x
patch (v, v)
diff (Send I v
a) = I v -> Send v x
forall v x. I v -> Send v x
Send ((v, v) -> I v -> I v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff I v
a)
instance Var v => Locks (Send v x) v where locks :: Send v x -> [Lock v]
locks Send v x
_ = []
instance FunctionSimulation (Send v x) v x where
    simulate :: CycleCntx v x -> Send v x -> [(v, x)]
simulate CycleCntx v x
_cntx Send{} = []

newtype Receive v x = Receive (O v) deriving (Typeable, Receive v x -> Receive v x -> Bool
(Receive v x -> Receive v x -> Bool)
-> (Receive v x -> Receive v x -> Bool) -> Eq (Receive v x)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v x. Eq v => Receive v x -> Receive v x -> Bool
$c== :: forall v x. Eq v => Receive v x -> Receive v x -> Bool
== :: Receive v x -> Receive v x -> Bool
$c/= :: forall v x. Eq v => Receive v x -> Receive v x -> Bool
/= :: Receive v x -> Receive v x -> Bool
Eq)
instance Var v => Show (Receive v x) where
    show :: Receive v x -> String
show (Receive O v
os) = String
"receive() = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> O v -> String
forall a. Show a => a -> String
show O v
os
instance Label (Receive v x) where label :: Receive v x -> String
label Receive{} = String
"receive"
receive :: (Var v, Val x) => [v] -> F v x
receive :: forall v x. (Var v, Val x) => [v] -> F v x
receive [v]
a = Receive v x -> F v x
forall {f} {v} {x}.
(Function f v, Patch f (v, v), Locks f v, Show f, Label f,
 FunctionSimulation f v x, Typeable f, Eq f) =>
f -> F v x
packF (Receive v x -> F v x) -> Receive v x -> F v x
forall a b. (a -> b) -> a -> b
$ O v -> Receive v x
forall v x. O v -> Receive v x
Receive (O v -> Receive v x) -> O v -> Receive v x
forall a b. (a -> b) -> a -> b
$ Set v -> O v
forall v. Set v -> O v
O (Set v -> O v) -> Set v -> O v
forall a b. (a -> b) -> a -> b
$ [v] -> Set v
forall a. Ord a => [a] -> Set a
S.fromList [v]
a
instance Var v => Function (Receive v x) v where
    outputs :: Receive v x -> Set v
outputs (Receive O v
o) = O v -> Set v
forall a v. Variables a v => a -> Set v
variables O v
o
instance Var v => Patch (Receive v x) (v, v) where
    patch :: (v, v) -> Receive v x -> Receive v x
patch (v, v)
diff (Receive O v
a) = O v -> Receive v x
forall v x. O v -> Receive v x
Receive ((v, v) -> O v -> O v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff O v
a)
instance Var v => Locks (Receive v x) v where locks :: Receive v x -> [Lock v]
locks Receive v x
_ = []
instance (Var v, Val x) => FunctionSimulation (Receive v x) v x where
    simulate :: CycleCntx v x -> Receive v x -> [(v, x)]
simulate CycleCntx{HashMap v x
cycleCntx :: forall v x. CycleCntx v x -> HashMap v x
cycleCntx :: HashMap v x
cycleCntx} (Receive (O Set v
vs)) =
        case Set v -> v
forall {c}. Set c -> c
oneOf Set v
vs v -> HashMap v x -> Maybe x
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
`HM.lookup` HashMap v x
cycleCntx of
            -- if output variables are defined - nothing to do (values thrown on upper level)
            Just x
_ -> []
            -- if output variables are not defined - set initial value
            Maybe x
Nothing -> [(v
v, x
forall a. Default a => a
def) | v
v <- Set v -> [v]
forall a. Set a -> [a]
S.elems Set v
vs]

-- | Special function for negative tests only.
data BrokenBuffer v x = BrokenBuffer (I v) (O v) deriving (Typeable, BrokenBuffer v x -> BrokenBuffer v x -> Bool
(BrokenBuffer v x -> BrokenBuffer v x -> Bool)
-> (BrokenBuffer v x -> BrokenBuffer v x -> Bool)
-> Eq (BrokenBuffer v x)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v x. Eq v => BrokenBuffer v x -> BrokenBuffer v x -> Bool
$c== :: forall v x. Eq v => BrokenBuffer v x -> BrokenBuffer v x -> Bool
== :: BrokenBuffer v x -> BrokenBuffer v x -> Bool
$c/= :: forall v x. Eq v => BrokenBuffer v x -> BrokenBuffer v x -> Bool
/= :: BrokenBuffer v x -> BrokenBuffer v x -> Bool
Eq)

instance Label (BrokenBuffer v x) where label :: BrokenBuffer v x -> String
label BrokenBuffer{} = String
"broken"
instance Var v => Show (BrokenBuffer v x) where
    show :: BrokenBuffer v x -> String
show (BrokenBuffer I v
i O v
os) = String
"brokenBuffer(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> I v -> String
forall a. Show a => a -> String
show I v
i String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> O v -> String
forall a. Show a => a -> String
show O v
os
brokenBuffer :: (Var v, Val x) => v -> [v] -> F v x
brokenBuffer :: forall v x. (Var v, Val x) => v -> [v] -> F v x
brokenBuffer v
a [v]
b = BrokenBuffer v x -> F v x
forall {f} {v} {x}.
(Function f v, Patch f (v, v), Locks f v, Show f, Label f,
 FunctionSimulation f v x, Typeable f, Eq f) =>
f -> F v x
packF (BrokenBuffer v x -> F v x) -> BrokenBuffer v x -> F v x
forall a b. (a -> b) -> a -> b
$ I v -> O v -> BrokenBuffer v x
forall v x. I v -> O v -> BrokenBuffer v x
BrokenBuffer (v -> I v
forall v. v -> I v
I v
a) (Set v -> O v
forall v. Set v -> O v
O (Set v -> O v) -> Set v -> O v
forall a b. (a -> b) -> a -> b
$ [v] -> Set v
forall a. Ord a => [a] -> Set a
S.fromList [v]
b)

instance Var v => Function (BrokenBuffer v x) v where
    inputs :: BrokenBuffer v x -> Set v
inputs (BrokenBuffer I v
a O v
_b) = I v -> Set v
forall a v. Variables a v => a -> Set v
variables I v
a
    outputs :: BrokenBuffer v x -> Set v
outputs (BrokenBuffer I v
_a O v
b) = O v -> Set v
forall a v. Variables a v => a -> Set v
variables O v
b
instance Var v => Patch (BrokenBuffer v x) (v, v) where
    patch :: (v, v) -> BrokenBuffer v x -> BrokenBuffer v x
patch (v, v)
diff (BrokenBuffer I v
a O v
b) = I v -> O v -> BrokenBuffer v x
forall v x. I v -> O v -> BrokenBuffer v x
BrokenBuffer ((v, v) -> I v -> I v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff I v
a) ((v, v) -> O v -> O v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff O v
b)
instance Var v => Locks (BrokenBuffer v x) v where
    locks :: BrokenBuffer v x -> [Lock v]
locks = BrokenBuffer v x -> [Lock v]
forall {f} {v}. Function f v => f -> [Lock v]
inputsLockOutputs
instance Var v => FunctionSimulation (BrokenBuffer v x) v x where
    simulate :: CycleCntx v x -> BrokenBuffer v x -> [(v, x)]
simulate CycleCntx v x
cntx (BrokenBuffer (I v
a) (O Set v
vs)) = [(v
v, CycleCntx v x
cntx CycleCntx v x -> v -> x
forall {a} {v}. (Hashable a, ToString a) => CycleCntx a v -> a -> v
`getCntx` v
a) | v
v <- Set v -> [v]
forall a. Set a -> [a]
S.elems Set v
vs]

data CmpOp = CmpEq | CmpLt | CmpLte | CmpGt | CmpGte
    deriving (Typeable, CmpOp -> CmpOp -> Bool
(CmpOp -> CmpOp -> Bool) -> (CmpOp -> CmpOp -> Bool) -> Eq CmpOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CmpOp -> CmpOp -> Bool
== :: CmpOp -> CmpOp -> Bool
$c/= :: CmpOp -> CmpOp -> Bool
/= :: CmpOp -> CmpOp -> Bool
Eq, Int -> CmpOp -> ShowS
[CmpOp] -> ShowS
CmpOp -> String
(Int -> CmpOp -> ShowS)
-> (CmpOp -> String) -> ([CmpOp] -> ShowS) -> Show CmpOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CmpOp -> ShowS
showsPrec :: Int -> CmpOp -> ShowS
$cshow :: CmpOp -> String
show :: CmpOp -> String
$cshowList :: [CmpOp] -> ShowS
showList :: [CmpOp] -> ShowS
Show, Typeable CmpOp
Typeable CmpOp =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> CmpOp -> c CmpOp)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CmpOp)
-> (CmpOp -> Constr)
-> (CmpOp -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CmpOp))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CmpOp))
-> ((forall b. Data b => b -> b) -> CmpOp -> CmpOp)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> CmpOp -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> CmpOp -> r)
-> (forall u. (forall d. Data d => d -> u) -> CmpOp -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> CmpOp -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> CmpOp -> m CmpOp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CmpOp -> m CmpOp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CmpOp -> m CmpOp)
-> Data CmpOp
CmpOp -> Constr
CmpOp -> DataType
(forall b. Data b => b -> b) -> CmpOp -> CmpOp
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> CmpOp -> u
forall u. (forall d. Data d => d -> u) -> CmpOp -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> CmpOp -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> CmpOp -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CmpOp -> m CmpOp
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CmpOp -> m CmpOp
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CmpOp
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CmpOp -> c CmpOp
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CmpOp)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CmpOp)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CmpOp -> c CmpOp
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CmpOp -> c CmpOp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CmpOp
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CmpOp
$ctoConstr :: CmpOp -> Constr
toConstr :: CmpOp -> Constr
$cdataTypeOf :: CmpOp -> DataType
dataTypeOf :: CmpOp -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CmpOp)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CmpOp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CmpOp)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CmpOp)
$cgmapT :: (forall b. Data b => b -> b) -> CmpOp -> CmpOp
gmapT :: (forall b. Data b => b -> b) -> CmpOp -> CmpOp
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> CmpOp -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> CmpOp -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> CmpOp -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> CmpOp -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CmpOp -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> CmpOp -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CmpOp -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CmpOp -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CmpOp -> m CmpOp
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CmpOp -> m CmpOp
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CmpOp -> m CmpOp
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CmpOp -> m CmpOp
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CmpOp -> m CmpOp
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CmpOp -> m CmpOp
Data, (forall x. CmpOp -> Rep CmpOp x)
-> (forall x. Rep CmpOp x -> CmpOp) -> Generic CmpOp
forall x. Rep CmpOp x -> CmpOp
forall x. CmpOp -> Rep CmpOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CmpOp -> Rep CmpOp x
from :: forall x. CmpOp -> Rep CmpOp x
$cto :: forall x. Rep CmpOp x -> CmpOp
to :: forall x. Rep CmpOp x -> CmpOp
Generic)

data Compare v x = Compare CmpOp (I v) (I v) (O v) deriving (Typeable, Compare v x -> Compare v x -> Bool
(Compare v x -> Compare v x -> Bool)
-> (Compare v x -> Compare v x -> Bool) -> Eq (Compare v x)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v x. Eq v => Compare v x -> Compare v x -> Bool
$c== :: forall v x. Eq v => Compare v x -> Compare v x -> Bool
== :: Compare v x -> Compare v x -> Bool
$c/= :: forall v x. Eq v => Compare v x -> Compare v x -> Bool
/= :: Compare v x -> Compare v x -> Bool
Eq)
instance Label (Compare v x) where
    label :: Compare v x -> String
label (Compare CmpOp
op I v
_ I v
_ O v
_) = CmpOp -> String
forall a. Show a => a -> String
show CmpOp
op
instance Var v => Patch (Compare v x) (v, v) where
    patch :: (v, v) -> Compare v x -> Compare v x
patch (v, v)
diff (Compare CmpOp
op I v
a I v
b O v
c) = CmpOp -> I v -> I v -> O v -> Compare v x
forall v x. CmpOp -> I v -> I v -> O v -> Compare v x
Compare CmpOp
op ((v, v) -> I v -> I v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff I v
a) ((v, v) -> I v -> I v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff I v
b) ((v, v) -> O v -> O v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff O v
c)

instance Var v => Show (Compare v x) where
    show :: Compare v x -> String
show (Compare CmpOp
op I v
a I v
b O v
o) = I v -> String
forall a. Show a => a -> String
show I v
a String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CmpOp -> String
forall a. Show a => a -> String
show CmpOp
op String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> I v -> String
forall a. Show a => a -> String
show I v
b String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> O v -> String
forall a. Show a => a -> String
show O v
o

instance Var v => Function (Compare v x) v where
    inputs :: Compare v x -> Set v
inputs (Compare CmpOp
_ I v
a I v
b O v
_) = I v -> Set v
forall a v. Variables a v => a -> Set v
variables I v
a Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
`S.union` I v -> Set v
forall a v. Variables a v => a -> Set v
variables I v
b
    outputs :: Compare v x -> Set v
outputs (Compare CmpOp
_ I v
_ I v
_ O v
o) = O v -> Set v
forall a v. Variables a v => a -> Set v
variables O v
o
instance (Var v, Val x) => FunctionSimulation (Compare v x) v x where
    simulate :: CycleCntx v x -> Compare v x -> [(v, x)]
simulate CycleCntx v x
cntx (Compare CmpOp
op (I v
a) (I v
b) (O Set v
o)) =
        let
            x1 :: x
x1 = CycleCntx v x -> v -> x
forall {a} {v}. (Hashable a, ToString a) => CycleCntx a v -> a -> v
getCntx CycleCntx v x
cntx v
a
            x2 :: x
x2 = CycleCntx v x -> v -> x
forall {a} {v}. (Hashable a, ToString a) => CycleCntx a v -> a -> v
getCntx CycleCntx v x
cntx v
b
            y :: x
y = if CmpOp -> x -> x -> Bool
forall {a}. Ord a => CmpOp -> a -> a -> Bool
op2func CmpOp
op x
x1 x
x2 then x
1 else x
0
         in
            [(v
v, x
y) | v
v <- Set v -> [v]
forall a. Set a -> [a]
S.elems Set v
o]
        where
            op2func :: CmpOp -> a -> a -> Bool
op2func CmpOp
CmpEq = a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
            op2func CmpOp
CmpLt = a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<)
            op2func CmpOp
CmpLte = a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=)
            op2func CmpOp
CmpGt = a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>)
            op2func CmpOp
CmpGte = a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=)
instance Var v => Locks (Compare v x) v where
    locks :: Compare v x -> [Lock v]
locks = Compare v x -> [Lock v]
forall {f} {v}. Function f v => f -> [Lock v]
inputsLockOutputs

cmp :: (Var v, Val x) => CmpOp -> v -> v -> [v] -> F v x
cmp :: forall v x. (Var v, Val x) => CmpOp -> v -> v -> [v] -> F v x
cmp CmpOp
op v
a v
b [v]
c = Compare v x -> F v x
forall {f} {v} {x}.
(Function f v, Patch f (v, v), Locks f v, Show f, Label f,
 FunctionSimulation f v x, Typeable f, Eq f) =>
f -> F v x
packF (Compare v x -> F v x) -> Compare v x -> F v x
forall a b. (a -> b) -> a -> b
$ CmpOp -> I v -> I v -> O v -> Compare v x
forall v x. CmpOp -> I v -> I v -> O v -> Compare v x
Compare CmpOp
op (v -> I v
forall v. v -> I v
I v
a) (v -> I v
forall v. v -> I v
I v
b) (O v -> Compare v x) -> O v -> Compare v x
forall a b. (a -> b) -> a -> b
$ Set v -> O v
forall v. Set v -> O v
O (Set v -> O v) -> Set v -> O v
forall a b. (a -> b) -> a -> b
$ [v] -> Set v
forall a. Ord a => [a] -> Set a
S.fromList [v]
c
data LogicFunction v x
    = LogicAnd (I v) (I v) (O v)
    | LogicOr (I v) (I v) (O v)
    | LogicNot (I v) (O v)
    deriving (Typeable, LogicFunction v x -> LogicFunction v x -> Bool
(LogicFunction v x -> LogicFunction v x -> Bool)
-> (LogicFunction v x -> LogicFunction v x -> Bool)
-> Eq (LogicFunction v x)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v x. Eq v => LogicFunction v x -> LogicFunction v x -> Bool
$c== :: forall v x. Eq v => LogicFunction v x -> LogicFunction v x -> Bool
== :: LogicFunction v x -> LogicFunction v x -> Bool
$c/= :: forall v x. Eq v => LogicFunction v x -> LogicFunction v x -> Bool
/= :: LogicFunction v x -> LogicFunction v x -> Bool
Eq)

deriving instance (Data v, Data (I v), Data (O v), Data x) => Data (LogicFunction v x)

logicAnd :: (Var v, Val x) => v -> v -> [v] -> F v x
logicAnd :: forall v x. (Var v, Val x) => v -> v -> [v] -> F v x
logicAnd v
a v
b [v]
c = LogicFunction v x -> F v x
forall {f} {v} {x}.
(Function f v, Patch f (v, v), Locks f v, Show f, Label f,
 FunctionSimulation f v x, Typeable f, Eq f) =>
f -> F v x
packF (LogicFunction v x -> F v x) -> LogicFunction v x -> F v x
forall a b. (a -> b) -> a -> b
$ I v -> I v -> O v -> LogicFunction v x
forall v x. I v -> I v -> O v -> LogicFunction v x
LogicAnd (v -> I v
forall v. v -> I v
I v
a) (v -> I v
forall v. v -> I v
I v
b) (O v -> LogicFunction v x) -> O v -> LogicFunction v x
forall a b. (a -> b) -> a -> b
$ Set v -> O v
forall v. Set v -> O v
O (Set v -> O v) -> Set v -> O v
forall a b. (a -> b) -> a -> b
$ [v] -> Set v
forall a. Ord a => [a] -> Set a
S.fromList [v]
c

logicOr :: (Var v, Val x) => v -> v -> [v] -> F v x
logicOr :: forall v x. (Var v, Val x) => v -> v -> [v] -> F v x
logicOr v
a v
b [v]
c = LogicFunction v x -> F v x
forall {f} {v} {x}.
(Function f v, Patch f (v, v), Locks f v, Show f, Label f,
 FunctionSimulation f v x, Typeable f, Eq f) =>
f -> F v x
packF (LogicFunction v x -> F v x) -> LogicFunction v x -> F v x
forall a b. (a -> b) -> a -> b
$ I v -> I v -> O v -> LogicFunction v x
forall v x. I v -> I v -> O v -> LogicFunction v x
LogicOr (v -> I v
forall v. v -> I v
I v
a) (v -> I v
forall v. v -> I v
I v
b) (O v -> LogicFunction v x) -> O v -> LogicFunction v x
forall a b. (a -> b) -> a -> b
$ Set v -> O v
forall v. Set v -> O v
O (Set v -> O v) -> Set v -> O v
forall a b. (a -> b) -> a -> b
$ [v] -> Set v
forall a. Ord a => [a] -> Set a
S.fromList [v]
c

logicNot :: (Var v, Val x) => v -> [v] -> F v x
logicNot :: forall v x. (Var v, Val x) => v -> [v] -> F v x
logicNot v
a [v]
c = LogicFunction v x -> F v x
forall {f} {v} {x}.
(Function f v, Patch f (v, v), Locks f v, Show f, Label f,
 FunctionSimulation f v x, Typeable f, Eq f) =>
f -> F v x
packF (LogicFunction v x -> F v x) -> LogicFunction v x -> F v x
forall a b. (a -> b) -> a -> b
$ I v -> O v -> LogicFunction v x
forall v x. I v -> O v -> LogicFunction v x
LogicNot (v -> I v
forall v. v -> I v
I v
a) (O v -> LogicFunction v x) -> O v -> LogicFunction v x
forall a b. (a -> b) -> a -> b
$ Set v -> O v
forall v. Set v -> O v
O (Set v -> O v) -> Set v -> O v
forall a b. (a -> b) -> a -> b
$ [v] -> Set v
forall a. Ord a => [a] -> Set a
S.fromList [v]
c

instance Label (LogicFunction v x) where
    label :: LogicFunction v x -> String
label LogicAnd{} = String
"and"
    label LogicOr{} = String
"or"
    label LogicNot{} = String
"not"

instance Var v => Patch (LogicFunction v x) (v, v) where
    patch :: (v, v) -> LogicFunction v x -> LogicFunction v x
patch (v, v)
diff (LogicAnd I v
a I v
b O v
c) = I v -> I v -> O v -> LogicFunction v x
forall v x. I v -> I v -> O v -> LogicFunction v x
LogicAnd ((v, v) -> I v -> I v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff I v
a) ((v, v) -> I v -> I v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff I v
b) ((v, v) -> O v -> O v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff O v
c)
    patch (v, v)
diff (LogicOr I v
a I v
b O v
c) = I v -> I v -> O v -> LogicFunction v x
forall v x. I v -> I v -> O v -> LogicFunction v x
LogicOr ((v, v) -> I v -> I v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff I v
a) ((v, v) -> I v -> I v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff I v
b) ((v, v) -> O v -> O v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff O v
c)
    patch (v, v)
diff (LogicNot I v
a O v
b) = I v -> O v -> LogicFunction v x
forall v x. I v -> O v -> LogicFunction v x
LogicNot ((v, v) -> I v -> I v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff I v
a) ((v, v) -> O v -> O v
forall f diff. Patch f diff => diff -> f -> f
patch (v, v)
diff O v
b)

instance Var v => Show (LogicFunction v x) where
    show :: LogicFunction v x -> String
show (LogicAnd I v
a I v
b O v
o) = I v -> String
forall a. Show a => a -> String
show I v
a String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" and " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> I v -> String
forall a. Show a => a -> String
show I v
b String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> O v -> String
forall a. Show a => a -> String
show O v
o
    show (LogicOr I v
a I v
b O v
o) = I v -> String
forall a. Show a => a -> String
show I v
a String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" or " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> I v -> String
forall a. Show a => a -> String
show I v
b String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> O v -> String
forall a. Show a => a -> String
show O v
o
    show (LogicNot I v
a O v
o) = String
"not " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> I v -> String
forall a. Show a => a -> String
show I v
a String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> O v -> String
forall a. Show a => a -> String
show O v
o

instance Var v => Function (LogicFunction v x) v where
    inputs :: LogicFunction v x -> Set v
inputs (LogicOr I v
a I v
b O v
_) = I v -> Set v
forall a v. Variables a v => a -> Set v
variables I v
a Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
`S.union` I v -> Set v
forall a v. Variables a v => a -> Set v
variables I v
b
    inputs (LogicAnd I v
a I v
b O v
_) = I v -> Set v
forall a v. Variables a v => a -> Set v
variables I v
a Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
`S.union` I v -> Set v
forall a v. Variables a v => a -> Set v
variables I v
b
    inputs (LogicNot I v
a O v
_) = I v -> Set v
forall a v. Variables a v => a -> Set v
variables I v
a
    outputs :: LogicFunction v x -> Set v
outputs (LogicOr I v
_ I v
_ O v
o) = O v -> Set v
forall a v. Variables a v => a -> Set v
variables O v
o
    outputs (LogicAnd I v
_ I v
_ O v
o) = O v -> Set v
forall a v. Variables a v => a -> Set v
variables O v
o
    outputs (LogicNot I v
_ O v
o) = O v -> Set v
forall a v. Variables a v => a -> Set v
variables O v
o
instance (Var v, B.Bits x, Num x, Ord x) => FunctionSimulation (LogicFunction v x) v x where
    simulate :: CycleCntx v x -> LogicFunction v x -> [(v, x)]
simulate CycleCntx v x
cntx (LogicAnd (I v
a) (I v
b) (O Set v
o)) =
        let x1 :: x
x1 = x -> x
forall x. (Num x, Eq x) => x -> x
toBool (CycleCntx v x
cntx CycleCntx v x -> v -> x
forall {a} {v}. (Hashable a, ToString a) => CycleCntx a v -> a -> v
`getCntx` v
a)
            x2 :: x
x2 = x -> x
forall x. (Num x, Eq x) => x -> x
toBool (CycleCntx v x
cntx CycleCntx v x -> v -> x
forall {a} {v}. (Hashable a, ToString a) => CycleCntx a v -> a -> v
`getCntx` v
b)
            y :: x
y = x
x1 x -> x -> x
forall a. Num a => a -> a -> a
* x
x2
         in [(v
v, x
y) | v
v <- Set v -> [v]
forall a. Set a -> [a]
S.elems Set v
o]
    simulate CycleCntx v x
cntx (LogicOr (I v
a) (I v
b) (O Set v
o)) =
        let x1 :: x
x1 = x -> x
forall x. (Num x, Eq x) => x -> x
toBool (CycleCntx v x
cntx CycleCntx v x -> v -> x
forall {a} {v}. (Hashable a, ToString a) => CycleCntx a v -> a -> v
`getCntx` v
a)
            x2 :: x
x2 = x -> x
forall x. (Num x, Eq x) => x -> x
toBool (CycleCntx v x
cntx CycleCntx v x -> v -> x
forall {a} {v}. (Hashable a, ToString a) => CycleCntx a v -> a -> v
`getCntx` v
b)
            y :: x
y = if x
x1 x -> x -> x
forall a. Num a => a -> a -> a
+ x
x2 x -> x -> Bool
forall a. Ord a => a -> a -> Bool
> x
0 then x
1 else x
0
         in [(v
v, x
y) | v
v <- Set v -> [v]
forall a. Set a -> [a]
S.elems Set v
o]
    simulate CycleCntx v x
cntx (LogicNot (I v
a) (O Set v
o)) =
        let x1 :: x
x1 = x -> x
forall x. (Num x, Eq x) => x -> x
toBool (CycleCntx v x
cntx CycleCntx v x -> v -> x
forall {a} {v}. (Hashable a, ToString a) => CycleCntx a v -> a -> v
`getCntx` v
a)
            y :: x
y = x
1 x -> x -> x
forall a. Num a => a -> a -> a
- x
x1
         in [(v
v, x
y) | v
v <- Set v -> [v]
forall a. Set a -> [a]
S.elems Set v
o]

toBool :: (Num x, Eq x) => x -> x
toBool :: forall x. (Num x, Eq x) => x -> x
toBool x
n = if x
n x -> x -> Bool
forall a. Eq a => a -> a -> Bool
/= x
0 then x
1 else x
0

instance Var v => Locks (LogicFunction v x) v where
    locks :: LogicFunction v x -> [Lock v]
locks = LogicFunction v x -> [Lock v]
forall {f} {v}. Function f v => f -> [Lock v]
inputsLockOutputs

-- Look Up Table
data TruthTable v x = TruthTable (M.Map [Bool] Bool) [I v] (O v) deriving (Typeable, TruthTable v x -> TruthTable v x -> Bool
(TruthTable v x -> TruthTable v x -> Bool)
-> (TruthTable v x -> TruthTable v x -> Bool)
-> Eq (TruthTable v x)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v x. Eq v => TruthTable v x -> TruthTable v x -> Bool
$c== :: forall v x. Eq v => TruthTable v x -> TruthTable v x -> Bool
== :: TruthTable v x -> TruthTable v x -> Bool
$c/= :: forall v x. Eq v => TruthTable v x -> TruthTable v x -> Bool
/= :: TruthTable v x -> TruthTable v x -> Bool
Eq)

instance Var v => Patch (TruthTable v x) (v, v) where
    patch :: (v, v) -> TruthTable v x -> TruthTable v x
patch (v
old, v
new) (TruthTable Map [Bool] Bool
table [I v]
ins O v
out) =
        Map [Bool] Bool -> [I v] -> O v -> TruthTable v x
forall v x. Map [Bool] Bool -> [I v] -> O v -> TruthTable v x
TruthTable Map [Bool] Bool
table ((v, v) -> [I v] -> [I v]
forall f diff. Patch f diff => diff -> f -> f
patch (v
old, v
new) [I v]
ins) ((v, v) -> O v -> O v
forall f diff. Patch f diff => diff -> f -> f
patch (v
old, v
new) O v
out)

instance Var v => Locks (TruthTable v x) v where
    locks :: TruthTable v x -> [Lock v]
locks (TruthTable{}) = []

instance Label (TruthTable v x) where
    label :: TruthTable v x -> String
label (TruthTable{}) = String
"TruthTable"
instance Var v => Show (TruthTable v x) where
    show :: TruthTable v x -> String
show (TruthTable Map [Bool] Bool
table [I v]
ins O v
output) = String
"TruthTable " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Map [Bool] Bool -> String
forall a. Show a => a -> String
show Map [Bool] Bool
table String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [I v] -> String
forall a. Show a => a -> String
show [I v]
ins String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> O v -> String
forall a. Show a => a -> String
show O v
output

instance Var v => Function (TruthTable v x) v where
    inputs :: TruthTable v x -> Set v
inputs (TruthTable Map [Bool] Bool
_ [I v]
ins O v
_) = [Set v] -> Set v
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions ([Set v] -> Set v) -> [Set v] -> Set v
forall a b. (a -> b) -> a -> b
$ (I v -> Set v) -> [I v] -> [Set v]
forall a b. (a -> b) -> [a] -> [b]
map I v -> Set v
forall a v. Variables a v => a -> Set v
variables [I v]
ins
    outputs :: TruthTable v x -> Set v
outputs (TruthTable Map [Bool] Bool
_ [I v]
_ O v
output) = O v -> Set v
forall a v. Variables a v => a -> Set v
variables O v
output

instance (Var v, Num x, Eq x) => FunctionSimulation (TruthTable v x) v x where
    simulate :: CycleCntx v x -> TruthTable v x -> [(v, x)]
simulate CycleCntx v x
cntx (TruthTable Map [Bool] Bool
table [I v]
ins (O Set v
output)) =
        let inputValues :: [Bool]
inputValues = (I v -> Bool) -> [I v] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (\(I v
v) -> CycleCntx v x
cntx CycleCntx v x -> v -> x
forall {a} {v}. (Hashable a, ToString a) => CycleCntx a v -> a -> v
`getCntx` v
v x -> x -> Bool
forall a. Eq a => a -> a -> Bool
== x
1) [I v]
ins
            result :: Bool
result = Bool -> [Bool] -> Map [Bool] Bool -> Bool
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Bool
False [Bool]
inputValues Map [Bool] Bool
table -- todo add default value
         in [(v
v, Int -> x
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
result)) | v
v <- Set v -> [v]
forall a. Set a -> [a]
S.elems Set v
output]

data Mux v x = Mux (I v) [I v] (O v) deriving (Typeable, Mux v x -> Mux v x -> Bool
(Mux v x -> Mux v x -> Bool)
-> (Mux v x -> Mux v x -> Bool) -> Eq (Mux v x)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v x. Eq v => Mux v x -> Mux v x -> Bool
$c== :: forall v x. Eq v => Mux v x -> Mux v x -> Bool
== :: Mux v x -> Mux v x -> Bool
$c/= :: forall v x. Eq v => Mux v x -> Mux v x -> Bool
/= :: Mux v x -> Mux v x -> Bool
Eq)

instance Var v => Patch (Mux v x) (v, v) where
    patch :: (v, v) -> Mux v x -> Mux v x
patch (v
old, v
new) (Mux I v
sel [I v]
ins O v
out) =
        I v -> [I v] -> O v -> Mux v x
forall v x. I v -> [I v] -> O v -> Mux v x
Mux ((v, v) -> I v -> I v
forall f diff. Patch f diff => diff -> f -> f
patch (v
old, v
new) I v
sel) [I v]
ins ((v, v) -> O v -> O v
forall f diff. Patch f diff => diff -> f -> f
patch (v
old, v
new) O v
out)

instance Var v => Locks (Mux v x) v where
    locks :: Mux v x -> [Lock v]
locks (Mux{}) = []

instance Label (Mux v x) where
    label :: Mux v x -> String
label (Mux{}) = String
"Mux"
instance Var v => Show (Mux v x) where
    show :: Mux v x -> String
show (Mux I v
ins [I v]
sel O v
output) = String
"Mux " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> I v -> String
forall a. Show a => a -> String
show I v
ins String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [I v] -> String
forall a. Show a => a -> String
show [I v]
sel String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> O v -> String
forall a. Show a => a -> String
show O v
output

instance Var v => Function (Mux v x) v where
    inputs :: Mux v x -> Set v
inputs (Mux I v
cond [I v]
ins O v
_) =
        [Set v] -> Set v
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions ([Set v] -> Set v) -> [Set v] -> Set v
forall a b. (a -> b) -> a -> b
$ (I v -> Set v) -> [I v] -> [Set v]
forall a b. (a -> b) -> [a] -> [b]
map I v -> Set v
forall a v. Variables a v => a -> Set v
variables ([I v]
ins [I v] -> [I v] -> [I v]
forall a. [a] -> [a] -> [a]
++ [I v
cond])
    outputs :: Mux v x -> Set v
outputs (Mux I v
_ [I v]
_ O v
output) = O v -> Set v
forall a v. Variables a v => a -> Set v
variables O v
output

instance (Var v, Val x) => FunctionSimulation (Mux v x) v x where
    simulate :: CycleCntx v x -> Mux v x -> [(v, x)]
simulate CycleCntx v x
cntx (Mux (I v
sel) [I v]
ins (O Set v
outs)) =
        let
            selValue :: x
selValue = CycleCntx v x -> v -> x
forall {a} {v}. (Hashable a, ToString a) => CycleCntx a v -> a -> v
getCntx CycleCntx v x
cntx v
sel x -> x -> x
forall a. Integral a => a -> a -> a
`mod` x
16
            insCount :: Int
insCount = [I v] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [I v]
ins
            selectedValue :: x
selectedValue
                | x
selValue x -> x -> Bool
forall a. Ord a => a -> a -> Bool
>= x
0 Bool -> Bool -> Bool
&& x -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral x
selValue Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
insCount =
                    case [I v]
ins [I v] -> Int -> I v
forall a. HasCallStack => [a] -> Int -> a
!! x -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (x
selValue x -> x -> x
forall a. Integral a => a -> a -> a
`mod` x
16) of
                        I v
inputVar -> CycleCntx v x -> v -> x
forall {a} {v}. (Hashable a, ToString a) => CycleCntx a v -> a -> v
getCntx CycleCntx v x
cntx v
inputVar
                | Bool
otherwise = x
0
         in
            [(v
outVar, x
selectedValue) | v
outVar <- Set v -> [v]
forall a. Set a -> [a]
S.elems Set v
outs]

mux :: (Var v, Val x) => [v] -> v -> [v] -> F v x
mux :: forall v x. (Var v, Val x) => [v] -> v -> [v] -> F v x
mux [v]
inps v
cond [v]
outs = Mux v x -> F v x
forall {f} {v} {x}.
(Function f v, Patch f (v, v), Locks f v, Show f, Label f,
 FunctionSimulation f v x, Typeable f, Eq f) =>
f -> F v x
packF (Mux v x -> F v x) -> Mux v x -> F v x
forall a b. (a -> b) -> a -> b
$ I v -> [I v] -> O v -> Mux v x
forall v x. I v -> [I v] -> O v -> Mux v x
Mux (v -> I v
forall v. v -> I v
I v
cond) ((v -> I v) -> [v] -> [I v]
forall a b. (a -> b) -> [a] -> [b]
map v -> I v
forall v. v -> I v
I [v]
inps) (O v -> Mux v x) -> O v -> Mux v x
forall a b. (a -> b) -> a -> b
$ Set v -> O v
forall v. Set v -> O v
O (Set v -> O v) -> Set v -> O v
forall a b. (a -> b) -> a -> b
$ [v] -> Set v
forall a. Ord a => [a] -> Set a
S.fromList [v]
outs