{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}

{- |
Module      : NITTA.Model.ProcessorUnits.Comparator
Description : A comparator that supports operations: <, <=, >, >=, ==
Copyright   : (c) Boris Novoselov, 2025
License     : BSD3
Stability   : experimental
-}
module NITTA.Model.ProcessorUnits.Comparator (
    Comparator,
    compare,
    Ports (..),
    IOPorts (..),
) where

import Control.Monad (when)
import Data.Bits hiding (bit)
import Data.Data (dataTypeConstrs, dataTypeOf)
import Data.Default (Default, def)
import Data.Foldable
import Data.List (partition, (\\))
import Data.Maybe
import Data.Set qualified as S
import Data.String.Interpolate
import Data.String.ToString
import Data.Text qualified as T
import NITTA.Intermediate.Functions qualified as F
import NITTA.Intermediate.Types
import NITTA.Model.Problems
import NITTA.Model.ProcessorUnits.Types
import NITTA.Model.Time
import NITTA.Project
import NITTA.Utils
import NITTA.Utils.ProcessDescription
import Numeric.Interval.NonEmpty hiding (elem, notElem)
import Prettyprinter
import Prelude hiding (compare)

data Comparator v x t = Comparator
    { forall v x t. Comparator v x t -> [F v x]
remain :: [F v x]
    , forall v x t. Comparator v x t -> [v]
targets :: [v]
    , forall v x t. Comparator v x t -> [v]
sources :: [v]
    , forall v x t. Comparator v x t -> Maybe (F v x)
currentWork :: Maybe (F v x)
    , forall v x t. Comparator v x t -> Process t (StepInfo v x t)
process_ :: Process t (StepInfo v x t)
    }

compare :: Time t => Comparator v x t
compare :: forall t v x. Time t => Comparator v x t
compare =
    Comparator
        { remain :: [F v x]
remain = []
        , targets :: [v]
targets = []
        , sources :: [v]
sources = []
        , currentWork :: Maybe (F v x)
currentWork = Maybe (F v x)
forall a. Maybe a
Nothing
        , process_ :: Process t (StepInfo v x t)
process_ = Process t (StepInfo v x t)
forall a. Default a => a
def
        }

instance VarValTime v x t => ProcessorUnit (Comparator v x t) v x t where
    tryBind :: F v x -> Comparator v x t -> Either String (Comparator v x t)
tryBind F v x
f pu :: Comparator v x t
pu@Comparator{[F v x]
remain :: forall v x t. Comparator v x t -> [F v x]
remain :: [F v x]
remain}
        | Just F.Compare{} <- F v x -> Maybe (Compare v x)
forall (f :: * -> * -> *) v x.
(Typeable f, Typeable v, Typeable x) =>
F v x -> Maybe (f v x)
castF F v x
f =
            Comparator v x t -> Either String (Comparator v x t)
forall a b. b -> Either a b
Right
                Comparator v x t
pu
                    { remain = f : remain
                    }
        | Bool
otherwise = String -> Either String (Comparator v x t)
forall a b. a -> Either a b
Left String
"Unsupported function type for Comparator"

    process :: Comparator v x t -> Process t (StepInfo v x t)
process = Comparator v x t -> Process t (StepInfo v x t)
forall v x t. Comparator v x t -> Process t (StepInfo v x t)
process_

instance Connected (Comparator v x t) where
    data Ports (Comparator v x t) = ComparePorts
        { forall v x t. Ports (Comparator v x t) -> SignalTag
oePort :: SignalTag
        , forall v x t. Ports (Comparator v x t) -> SignalTag
wrPort :: SignalTag
        , forall v x t. Ports (Comparator v x t) -> [SignalTag]
opSelPort :: [SignalTag]
        }
        deriving (Int -> Ports (Comparator v x t) -> ShowS
[Ports (Comparator v x t)] -> ShowS
Ports (Comparator v x t) -> String
(Int -> Ports (Comparator v x t) -> ShowS)
-> (Ports (Comparator v x t) -> String)
-> ([Ports (Comparator v x t)] -> ShowS)
-> Show (Ports (Comparator v x t))
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall v x t. Int -> Ports (Comparator v x t) -> ShowS
forall v x t. [Ports (Comparator v x t)] -> ShowS
forall v x t. Ports (Comparator v x t) -> String
$cshowsPrec :: forall v x t. Int -> Ports (Comparator v x t) -> ShowS
showsPrec :: Int -> Ports (Comparator v x t) -> ShowS
$cshow :: forall v x t. Ports (Comparator v x t) -> String
show :: Ports (Comparator v x t) -> String
$cshowList :: forall v x t. [Ports (Comparator v x t)] -> ShowS
showList :: [Ports (Comparator v x t)] -> ShowS
Show)

supportedOpsNum :: Int
supportedOpsNum :: Int
supportedOpsNum = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ [Constr] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (DataType -> [Constr]
dataTypeConstrs (DataType -> [Constr]) -> DataType -> [Constr]
forall a b. (a -> b) -> a -> b
$ CmpOp -> DataType
forall a. Data a => a -> DataType
dataTypeOf CmpOp
F.CmpEq)
selWidth :: Int
selWidth = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
2 (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
supportedOpsNum) :: Double) :: Int

instance Controllable (Comparator v x t) where
    data Instruction (Comparator v x t)
        = Load F.CmpOp
        | Out
        deriving (Int -> Instruction (Comparator v x t) -> ShowS
[Instruction (Comparator v x t)] -> ShowS
Instruction (Comparator v x t) -> String
(Int -> Instruction (Comparator v x t) -> ShowS)
-> (Instruction (Comparator v x t) -> String)
-> ([Instruction (Comparator v x t)] -> ShowS)
-> Show (Instruction (Comparator v x t))
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall v x t. Int -> Instruction (Comparator v x t) -> ShowS
forall v x t. [Instruction (Comparator v x t)] -> ShowS
forall v x t. Instruction (Comparator v x t) -> String
$cshowsPrec :: forall v x t. Int -> Instruction (Comparator v x t) -> ShowS
showsPrec :: Int -> Instruction (Comparator v x t) -> ShowS
$cshow :: forall v x t. Instruction (Comparator v x t) -> String
show :: Instruction (Comparator v x t) -> String
$cshowList :: forall v x t. [Instruction (Comparator v x t)] -> ShowS
showList :: [Instruction (Comparator v x t)] -> ShowS
Show)

    data Microcode (Comparator v x t) = Microcode
        { forall v x t. Microcode (Comparator v x t) -> Bool
oe :: Bool
        , forall v x t. Microcode (Comparator v x t) -> Bool
wr :: Bool
        , forall v x t. Microcode (Comparator v x t) -> Int
opSel :: Int
        }
        deriving (Int -> Microcode (Comparator v x t) -> ShowS
[Microcode (Comparator v x t)] -> ShowS
Microcode (Comparator v x t) -> String
(Int -> Microcode (Comparator v x t) -> ShowS)
-> (Microcode (Comparator v x t) -> String)
-> ([Microcode (Comparator v x t)] -> ShowS)
-> Show (Microcode (Comparator v x t))
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall v x t. Int -> Microcode (Comparator v x t) -> ShowS
forall v x t. [Microcode (Comparator v x t)] -> ShowS
forall v x t. Microcode (Comparator v x t) -> String
$cshowsPrec :: forall v x t. Int -> Microcode (Comparator v x t) -> ShowS
showsPrec :: Int -> Microcode (Comparator v x t) -> ShowS
$cshow :: forall v x t. Microcode (Comparator v x t) -> String
show :: Microcode (Comparator v x t) -> String
$cshowList :: forall v x t. [Microcode (Comparator v x t)] -> ShowS
showList :: [Microcode (Comparator v x t)] -> ShowS
Show, Microcode (Comparator v x t)
-> Microcode (Comparator v x t) -> Bool
(Microcode (Comparator v x t)
 -> Microcode (Comparator v x t) -> Bool)
-> (Microcode (Comparator v x t)
    -> Microcode (Comparator v x t) -> Bool)
-> Eq (Microcode (Comparator v x t))
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v x t.
Microcode (Comparator v x t)
-> Microcode (Comparator v x t) -> Bool
$c== :: forall v x t.
Microcode (Comparator v x t)
-> Microcode (Comparator v x t) -> Bool
== :: Microcode (Comparator v x t)
-> Microcode (Comparator v x t) -> Bool
$c/= :: forall v x t.
Microcode (Comparator v x t)
-> Microcode (Comparator v x t) -> Bool
/= :: Microcode (Comparator v x t)
-> Microcode (Comparator v x t) -> Bool
Eq)

    zipSignalTagsAndValues :: Ports (Comparator v x t)
-> Microcode (Comparator v x t) -> [(SignalTag, SignalValue)]
zipSignalTagsAndValues ComparePorts{[SignalTag]
SignalTag
oePort :: forall v x t. Ports (Comparator v x t) -> SignalTag
wrPort :: forall v x t. Ports (Comparator v x t) -> SignalTag
opSelPort :: forall v x t. Ports (Comparator v x t) -> [SignalTag]
oePort :: SignalTag
wrPort :: SignalTag
opSelPort :: [SignalTag]
..} Microcode{Bool
Int
oe :: forall v x t. Microcode (Comparator v x t) -> Bool
wr :: forall v x t. Microcode (Comparator v x t) -> Bool
opSel :: forall v x t. Microcode (Comparator v x t) -> Int
oe :: Bool
wr :: Bool
opSel :: Int
..} =
        [ (SignalTag
oePort, Bool -> SignalValue
Bool Bool
oe)
        , (SignalTag
wrPort, Bool -> SignalValue
Bool Bool
wr)
        ]
            [(SignalTag, SignalValue)]
-> [(SignalTag, SignalValue)] -> [(SignalTag, SignalValue)]
forall a. [a] -> [a] -> [a]
++ (SignalTag -> Bool -> (SignalTag, SignalValue))
-> [SignalTag] -> [Bool] -> [(SignalTag, SignalValue)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\SignalTag
tag Bool
bit -> (SignalTag
tag, Bool -> SignalValue
Bool Bool
bit)) [SignalTag]
opSelPort (Int -> Int -> [Bool]
forall {a}. Bits a => a -> Int -> [Bool]
bits Int
opSel Int
selWidth)
        where
            bits :: a -> Int -> [Bool]
bits a
val Int
localWidth = [a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
val (Int
localWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) | Int
idx <- [Int
0 .. Int
localWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]
    usedPortTags :: Ports (Comparator v x t) -> [SignalTag]
usedPortTags ComparePorts{SignalTag
oePort :: forall v x t. Ports (Comparator v x t) -> SignalTag
oePort :: SignalTag
oePort, SignalTag
wrPort :: forall v x t. Ports (Comparator v x t) -> SignalTag
wrPort :: SignalTag
wrPort, [SignalTag]
opSelPort :: forall v x t. Ports (Comparator v x t) -> [SignalTag]
opSelPort :: [SignalTag]
opSelPort} = SignalTag
oePort SignalTag -> [SignalTag] -> [SignalTag]
forall a. a -> [a] -> [a]
: SignalTag
wrPort SignalTag -> [SignalTag] -> [SignalTag]
forall a. a -> [a] -> [a]
: [SignalTag]
opSelPort

    takePortTags :: [SignalTag] -> Comparator v x t -> Ports (Comparator v x t)
takePortTags (SignalTag
oe : SignalTag
wr : [SignalTag]
xs) Comparator v x t
_ = SignalTag -> SignalTag -> [SignalTag] -> Ports (Comparator v x t)
forall v x t.
SignalTag -> SignalTag -> [SignalTag] -> Ports (Comparator v x t)
ComparePorts SignalTag
oe SignalTag
wr [SignalTag]
sel
        where
            sel :: [SignalTag]
sel = Int -> [SignalTag] -> [SignalTag]
forall a. Int -> [a] -> [a]
take Int
selWidth [SignalTag]
xs
    takePortTags [SignalTag]
_ Comparator v x t
_ = String -> Ports (Comparator v x t)
forall a. HasCallStack => String -> a
error String
"can not take port tags, tags are over"

instance Var v => Locks (Comparator v x t) v where
    locks :: Comparator v x t -> [Lock v]
locks Comparator{[F v x]
remain :: forall v x t. Comparator v x t -> [F v x]
remain :: [F v x]
remain, [v]
sources :: forall v x t. Comparator v x t -> [v]
sources :: [v]
sources, [v]
targets :: forall v x t. Comparator v x t -> [v]
targets :: [v]
targets} =
        [ Lock{v
lockBy :: v
lockBy :: v
lockBy, v
locked :: v
locked :: v
locked}
        | v
locked <- [v]
sources
        , v
lockBy <- [v]
targets
        ]
            [Lock v] -> [Lock v] -> [Lock v]
forall a. [a] -> [a] -> [a]
++ [ Lock{v
lockBy :: v
lockBy :: v
lockBy, v
locked :: v
locked :: v
locked}
               | v
locked <- (F v x -> [v]) -> [F v x] -> [v]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Set v -> [v]
forall a. Set a -> [a]
S.elems (Set v -> [v]) -> (F v x -> Set v) -> F v x -> [v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. F v x -> Set v
forall a v. Variables a v => a -> Set v
variables) [F v x]
remain
               , v
lockBy <- [v]
sources [v] -> [v] -> [v]
forall a. [a] -> [a] -> [a]
++ [v]
targets
               ]
            [Lock v] -> [Lock v] -> [Lock v]
forall a. [a] -> [a] -> [a]
++ (F v x -> [Lock v]) -> [F v x] -> [Lock v]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap F v x -> [Lock v]
forall x v. Locks x v => x -> [Lock v]
locks [F v x]
remain
instance Default (Microcode (Comparator v x t)) where
    def :: Microcode (Comparator v x t)
def =
        Microcode
            { wr :: Bool
wr = Bool
False
            , oe :: Bool
oe = Bool
False
            , opSel :: Int
opSel = Int
0
            }

instance UnambiguouslyDecode (Comparator v x t) where
    decodeInstruction :: Instruction (Comparator v x t) -> Microcode (Comparator v x t)
decodeInstruction Instruction (Comparator v x t)
R:InstructionComparator v x t
Out = Microcode (Comparator Any Any Any)
forall a. Default a => a
def{oe = True}
    decodeInstruction (Load CmpOp
op) = case CmpOp
op of
        CmpOp
F.CmpEq -> Microcode (Comparator Any Any Any)
forall a. Default a => a
def{opSel = 0, wr = True}
        CmpOp
F.CmpLt -> Microcode (Comparator Any Any Any)
forall a. Default a => a
def{opSel = 1, wr = True}
        CmpOp
F.CmpLte -> Microcode (Comparator Any Any Any)
forall a. Default a => a
def{opSel = 2, wr = True}
        CmpOp
F.CmpGt -> Microcode (Comparator Any Any Any)
forall a. Default a => a
def{opSel = 3, wr = True}
        CmpOp
F.CmpGte -> Microcode (Comparator Any Any Any)
forall a. Default a => a
def{opSel = 4, wr = True}

instance Default x => DefaultX (Comparator v x t) x

instance Time t => Default (Comparator v x t) where
    def :: Comparator v x t
def = Comparator v x t
forall t v x. Time t => Comparator v x t
compare

flipCmpOp :: F.CmpOp -> F.CmpOp
flipCmpOp :: CmpOp -> CmpOp
flipCmpOp CmpOp
F.CmpEq = CmpOp
F.CmpEq
flipCmpOp CmpOp
F.CmpLt = CmpOp
F.CmpGt
flipCmpOp CmpOp
F.CmpLte = CmpOp
F.CmpGte
flipCmpOp CmpOp
F.CmpGt = CmpOp
F.CmpLt
flipCmpOp CmpOp
F.CmpGte = CmpOp
F.CmpLte

instance VarValTime v x t => EndpointProblem (Comparator v x t) v t where
    endpointOptions :: Comparator v x t -> [EndpointSt v (TimeConstraint t)]
endpointOptions pu :: Comparator v x t
pu@Comparator{targets :: forall v x t. Comparator v x t -> [v]
targets = v
target : [v]
_} =
        [EndpointRole v
-> TimeConstraint t -> EndpointSt v (TimeConstraint t)
forall v tp. EndpointRole v -> tp -> EndpointSt v tp
EndpointSt (v -> EndpointRole v
forall v. v -> EndpointRole v
Target v
target) (TimeConstraint t -> EndpointSt v (TimeConstraint t))
-> TimeConstraint t -> EndpointSt v (TimeConstraint t)
forall a b. (a -> b) -> a -> b
$ Interval t -> Interval t -> TimeConstraint t
forall t. Interval t -> Interval t -> TimeConstraint t
TimeConstraint Interval t
at Interval t
duration]
        where
            at :: Interval t
at = Comparator v x t -> t
forall u t. NextTick u t => u -> t
nextTick Comparator v x t
pu t -> t -> Interval t
forall a. Ord a => a -> a -> Interval a
... t
forall a. Bounded a => a
maxBound
            duration :: Interval t
duration = t
1 t -> t -> Interval t
forall a. Ord a => a -> a -> Interval a
... t
forall a. Bounded a => a
maxBound
    endpointOptions
        pu :: Comparator v x t
pu@Comparator
            { sources :: forall v x t. Comparator v x t -> [v]
sources = v
_ : [v]
_
            , currentWork :: forall v x t. Comparator v x t -> Maybe (F v x)
currentWork = Just F v x
f
            , Process t (StepInfo v x t)
process_ :: forall v x t. Comparator v x t -> Process t (StepInfo v x t)
process_ :: Process t (StepInfo v x t)
process_
            } = [EndpointRole v
-> TimeConstraint t -> EndpointSt v (TimeConstraint t)
forall v tp. EndpointRole v -> tp -> EndpointSt v tp
EndpointSt (Set v -> EndpointRole v
forall v. Set v -> EndpointRole v
Source (Set v -> EndpointRole v) -> Set v -> EndpointRole v
forall a b. (a -> b) -> a -> b
$ [v] -> Set v
forall a. Ord a => [a] -> Set a
S.fromList (Comparator v x t -> [v]
forall v x t. Comparator v x t -> [v]
sources Comparator v x t
pu)) (TimeConstraint t -> EndpointSt v (TimeConstraint t))
-> TimeConstraint t -> EndpointSt v (TimeConstraint t)
forall a b. (a -> b) -> a -> b
$ Interval t -> Interval t -> TimeConstraint t
forall t. Interval t -> Interval t -> TimeConstraint t
TimeConstraint Interval t
at Interval t
duration]
            where
                doneAt :: t
doneAt = Process t (StepInfo v x t) -> F v x -> t
forall {a1} {a2} {f} {x} {t2}.
(Ord a1, Ord a2, Function f a2) =>
Process a1 (StepInfo a2 x t2) -> f -> a1
inputsPushedAt Process t (StepInfo v x t)
process_ F v x
f t -> t -> t
forall a. Num a => a -> a -> a
+ t
3
                at :: Interval t
at = t -> t -> t
forall a. Ord a => a -> a -> a
max t
doneAt (Process t (StepInfo v x t) -> t
forall u t. NextTick u t => u -> t
nextTick Process t (StepInfo v x t)
process_) t -> t -> Interval t
forall a. Ord a => a -> a -> Interval a
... t
forall a. Bounded a => a
maxBound
                duration :: Interval t
duration = t
1 t -> t -> Interval t
forall a. Ord a => a -> a -> Interval a
... t
forall a. Bounded a => a
maxBound
    endpointOptions pu :: Comparator v x t
pu@Comparator{[F v x]
remain :: forall v x t. Comparator v x t -> [F v x]
remain :: [F v x]
remain} =
        (F v x -> [EndpointSt v (TimeConstraint t)])
-> [F v x] -> [EndpointSt v (TimeConstraint t)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Comparator v x t -> [EndpointSt v (TimeConstraint t)]
forall u v t.
EndpointProblem u v t =>
u -> [EndpointSt v (TimeConstraint t)]
endpointOptions (Comparator v x t -> [EndpointSt v (TimeConstraint t)])
-> (F v x -> Comparator v x t)
-> F v x
-> [EndpointSt v (TimeConstraint t)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Comparator v x t -> F v x -> Comparator v x t
forall {v} {x} {t}.
(Typeable v, Typeable x) =>
Comparator v x t -> F v x -> Comparator v x t
execution Comparator v x t
pu) [F v x]
remain

    endpointDecision :: Comparator v x t -> EndpointSt v (Interval t) -> Comparator v x t
endpointDecision pu :: Comparator v x t
pu@Comparator{[v]
targets :: forall v x t. Comparator v x t -> [v]
targets :: [v]
targets, Maybe (F v x)
currentWork :: forall v x t. Comparator v x t -> Maybe (F v x)
currentWork :: Maybe (F v x)
currentWork} d :: EndpointSt v (Interval t)
d@EndpointSt{epRole :: forall v tp. EndpointSt v tp -> EndpointRole v
epRole = Target v
v, Interval t
epAt :: Interval t
epAt :: forall v tp. EndpointSt v tp -> tp
epAt}
        | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [v] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [v]
targets
        , ([v
_], [v]
targets') <- (v -> Bool) -> [v] -> ([v], [v])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
v) [v]
targets
        , --  Computation process planning is carried out.
          let process_' :: Process t (StepInfo v x t)
process_' = Comparator v x t
-> State (Schedule (Comparator v x t) v x t) [Int]
-> Process t (StepInfo v x t)
forall {u} {v} {x} {t} {a}.
ProcessorUnit u v x t =>
u -> State (Schedule u v x t) a -> Process t (StepInfo v x t)
execSchedule Comparator v x t
pu (State (Schedule (Comparator v x t) v x t) [Int]
 -> Process t (StepInfo v x t))
-> State (Schedule (Comparator v x t) v x t) [Int]
-> Process t (StepInfo v x t)
forall a b. (a -> b) -> a -> b
$ do
                -- this is required for correct work of automatically generated tests,
                -- that takes information about time from Process
                case Maybe (F v x)
currentWork of
                    Just F v x
f
                        | Just (F.Compare CmpOp
op (I v
a) (I v
_) O v
_) <- F v x -> Maybe (Compare v x)
forall (f :: * -> * -> *) v x.
(Typeable f, Typeable v, Typeable x) =>
F v x -> Maybe (f v x)
castF F v x
f ->
                            let adjustedOp :: CmpOp
adjustedOp = if v
v v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
a then CmpOp
op else CmpOp -> CmpOp
flipCmpOp CmpOp
op
                             in EndpointSt v (Interval t)
-> State (Schedule (Comparator v x t) v x t) [Int]
-> State (Schedule (Comparator v x t) v x t) [Int]
forall {m :: * -> *} {pu} {v} {x} {t}.
MonadState (Schedule pu v x t) m =>
EndpointSt v (Interval t) -> m [Int] -> m [Int]
scheduleEndpoint EndpointSt v (Interval t)
d (State (Schedule (Comparator v x t) v x t) [Int]
 -> State (Schedule (Comparator v x t) v x t) [Int])
-> State (Schedule (Comparator v x t) v x t) [Int]
-> State (Schedule (Comparator v x t) v x t) [Int]
forall a b. (a -> b) -> a -> b
$ Interval t
-> Instruction (Comparator v x t)
-> State (Schedule (Comparator v x t) v x t) [Int]
forall {m :: * -> *} {pu} {v} {x} {t}.
(MonadState (Schedule pu v x t) m, Show (Instruction pu),
 Typeable pu, Num t) =>
Interval t -> Instruction pu -> m [Int]
scheduleInstructionUnsafe Interval t
epAt (CmpOp -> Instruction (Comparator v x t)
forall v x t. CmpOp -> Instruction (Comparator v x t)
Load CmpOp
adjustedOp)
                        | Bool
otherwise -> String -> State (Schedule (Comparator v x t) v x t) [Int]
forall a. HasCallStack => String -> a
error String
"Unsupported function type for Comparator"
                    Maybe (F v x)
Nothing -> String -> State (Schedule (Comparator v x t) v x t) [Int]
forall a. HasCallStack => String -> a
error String
"cmpOp is Nothing" =
            Comparator v x t
pu
                { process_ = process_'
                , -- The remainder of the work is saved for the next loop
                  targets = targets'
                }
    endpointDecision pu :: Comparator v x t
pu@Comparator{targets :: forall v x t. Comparator v x t -> [v]
targets = [], [v]
sources :: forall v x t. Comparator v x t -> [v]
sources :: [v]
sources, currentWork :: forall v x t. Comparator v x t -> Maybe (F v x)
currentWork = Just F v x
f, Process t (StepInfo v x t)
process_ :: forall v x t. Comparator v x t -> Process t (StepInfo v x t)
process_ :: Process t (StepInfo v x t)
process_} d :: EndpointSt v (Interval t)
d@EndpointSt{epRole :: forall v tp. EndpointSt v tp -> EndpointRole v
epRole = Source Set v
v, Interval t
epAt :: forall v tp. EndpointSt v tp -> tp
epAt :: Interval t
epAt}
        | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [v] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [v]
sources
        , let sources' :: [v]
sources' = [v]
sources [v] -> [v] -> [v]
forall a. Eq a => [a] -> [a] -> [a]
\\ Set v -> [v]
forall a. Set a -> [a]
S.elems Set v
v
        , [v]
sources' [v] -> [v] -> Bool
forall a. Eq a => a -> a -> Bool
/= [v]
sources
        , let a :: t
a = Interval t -> t
forall a. Interval a -> a
inf (Interval t -> t) -> Interval t -> t
forall a b. (a -> b) -> a -> b
$ [Step t (StepInfo v x t)] -> Interval t
forall {a} {i}. Ord a => [Step a i] -> Interval a
stepsInterval ([Step t (StepInfo v x t)] -> Interval t)
-> [Step t (StepInfo v x t)] -> Interval t
forall a b. (a -> b) -> a -> b
$ Process t (StepInfo v x t) -> Set v -> [Step t (StepInfo v x t)]
forall {a} {t1} {x} {t2}.
Ord a =>
Process t1 (StepInfo a x t2)
-> Set a -> [Step t1 (StepInfo a x t2)]
relatedEndpoints Process t (StepInfo v x t)
process_ (Set v -> [Step t (StepInfo v x t)])
-> Set v -> [Step t (StepInfo v x t)]
forall a b. (a -> b) -> a -> b
$ F v x -> Set v
forall a v. Variables a v => a -> Set v
variables F v x
f
        , -- Compututation process planning is carring on.
          let process_' :: Process t (StepInfo v x t)
process_' = Comparator v x t
-> State (Schedule (Comparator v x t) v x t) [Int]
-> Process t (StepInfo v x t)
forall {u} {v} {x} {t} {a}.
ProcessorUnit u v x t =>
u -> State (Schedule u v x t) a -> Process t (StepInfo v x t)
execSchedule Comparator v x t
pu (State (Schedule (Comparator v x t) v x t) [Int]
 -> Process t (StepInfo v x t))
-> State (Schedule (Comparator v x t) v x t) [Int]
-> Process t (StepInfo v x t)
forall a b. (a -> b) -> a -> b
$ do
                [Int]
endpoints <- EndpointSt v (Interval t)
-> State (Schedule (Comparator v x t) v x t) [Int]
-> State (Schedule (Comparator v x t) v x t) [Int]
forall {m :: * -> *} {pu} {v} {x} {t}.
MonadState (Schedule pu v x t) m =>
EndpointSt v (Interval t) -> m [Int] -> m [Int]
scheduleEndpoint EndpointSt v (Interval t)
d (State (Schedule (Comparator v x t) v x t) [Int]
 -> State (Schedule (Comparator v x t) v x t) [Int])
-> State (Schedule (Comparator v x t) v x t) [Int]
-> State (Schedule (Comparator v x t) v x t) [Int]
forall a b. (a -> b) -> a -> b
$ Interval t
-> Instruction (Comparator v x t)
-> State (Schedule (Comparator v x t) v x t) [Int]
forall {m :: * -> *} {pu} {v} {x} {t}.
(MonadState (Schedule pu v x t) m, Show (Instruction pu),
 Typeable pu, Num t) =>
Interval t -> Instruction pu -> m [Int]
scheduleInstructionUnsafe Interval t
epAt Instruction (Comparator v x t)
forall v x t. Instruction (Comparator v x t)
Out
                Bool
-> StateT (Schedule (Comparator v x t) v x t) Identity ()
-> StateT (Schedule (Comparator v x t) v x t) Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([v] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [v]
sources') (StateT (Schedule (Comparator v x t) v x t) Identity ()
 -> StateT (Schedule (Comparator v x t) v x t) Identity ())
-> StateT (Schedule (Comparator v x t) v x t) Identity ()
-> StateT (Schedule (Comparator v x t) v x t) Identity ()
forall a b. (a -> b) -> a -> b
$ do
                    [Int]
-> F v x
-> Interval t
-> StateT (Schedule (Comparator v x t) v x t) Identity ()
forall {v} {x} {t} {pu}.
(Ord v, Typeable v, IsString v, ToString v, Suffix v,
 Hashable v) =>
[Int]
-> F v x -> Interval t -> StateT (Schedule pu v x t) Identity ()
scheduleFunctionFinish_ [] F v x
f (Interval t
 -> StateT (Schedule (Comparator v x t) v x t) Identity ())
-> Interval t
-> StateT (Schedule (Comparator v x t) v x t) Identity ()
forall a b. (a -> b) -> a -> b
$ t
a t -> t -> Interval t
forall a. Ord a => a -> a -> Interval a
... Interval t -> t
forall a. Interval a -> a
sup Interval t
epAt
                [Int] -> State (Schedule (Comparator v x t) v x t) [Int]
forall a.
a -> StateT (Schedule (Comparator v x t) v x t) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [Int]
endpoints =
            Comparator v x t
pu
                { process_ = process_'
                , -- In case if not all variables what asked - remaining are saved.
                  sources = sources'
                , -- if all of works is done, then time when result is ready,
                  -- current work and data transfering, what is done is the current function is reset.
                  currentWork = if null sources' then Nothing else Just f
                }
    endpointDecision pu :: Comparator v x t
pu@Comparator{targets :: forall v x t. Comparator v x t -> [v]
targets = [], sources :: forall v x t. Comparator v x t -> [v]
sources = [], [F v x]
remain :: forall v x t. Comparator v x t -> [F v x]
remain :: [F v x]
remain} EndpointSt v (Interval t)
d
        | let v :: v
v = Set v -> v
forall {c}. Set c -> c
oneOf (Set v -> v) -> Set v -> v
forall a b. (a -> b) -> a -> b
$ EndpointSt v (Interval t) -> Set v
forall a v. Variables a v => a -> Set v
variables EndpointSt v (Interval t)
d
        , Just F v x
f <- (F v x -> Bool) -> [F v x] -> Maybe (F v x)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\F v x
f -> v
v v -> Set v -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` F v x -> Set v
forall a v. Variables a v => a -> Set v
variables F v x
f) [F v x]
remain =
            Comparator v x t -> EndpointSt v (Interval t) -> Comparator v x t
forall u v t.
EndpointProblem u v t =>
u -> EndpointSt v (Interval t) -> u
endpointDecision (Comparator v x t -> F v x -> Comparator v x t
forall {v} {x} {t}.
(Typeable v, Typeable x) =>
Comparator v x t -> F v x -> Comparator v x t
execution Comparator v x t
pu F v x
f) EndpointSt v (Interval t)
d
    endpointDecision Comparator v x t
pu EndpointSt v (Interval t)
d = String -> Comparator v x t
forall a. HasCallStack => String -> a
error [i|incorrect decision #{ d } for #{ pretty pu }|]

execution :: Comparator v x t -> F v x -> Comparator v x t
execution pu :: Comparator v x t
pu@Comparator{targets :: forall v x t. Comparator v x t -> [v]
targets = [], sources :: forall v x t. Comparator v x t -> [v]
sources = [], [F v x]
remain :: forall v x t. Comparator v x t -> [F v x]
remain :: [F v x]
remain} F v x
f
    | Just (F.Compare CmpOp
_ (I v
a) (I v
b) (O Set v
c)) <- F v x -> Maybe (Compare v x)
forall (f :: * -> * -> *) v x.
(Typeable f, Typeable v, Typeable x) =>
F v x -> Maybe (f v x)
castF F v x
f =
        Comparator v x t
pu
            { targets = [a, b]
            , currentWork = Just f
            , sources = S.elems c
            , remain = filter (/= f) remain
            }
execution Comparator v x t
_ F v x
f =
    String -> Comparator v x t
forall a. HasCallStack => String -> a
error (String -> Comparator v x t) -> String -> Comparator v x t
forall a b. (a -> b) -> a -> b
$
        String
"Comparator: internal execution error. Expected Compare, got: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ F v x -> String
forall a. Show a => a -> String
show F v x
f

instance VarValTime v x t => Pretty (Comparator v x t) where
    pretty :: forall ann. Comparator v x t -> Doc ann
pretty Comparator{[F v x]
remain :: forall v x t. Comparator v x t -> [F v x]
remain :: [F v x]
remain, [v]
targets :: forall v x t. Comparator v x t -> [v]
targets :: [v]
targets, [v]
sources :: forall v x t. Comparator v x t -> [v]
sources :: [v]
sources, Maybe (F v x)
currentWork :: forall v x t. Comparator v x t -> Maybe (F v x)
currentWork :: Maybe (F v x)
currentWork, Process t (StepInfo v x t)
process_ :: forall v x t. Comparator v x t -> Process t (StepInfo v x t)
process_ :: Process t (StepInfo v x t)
process_} =
        [__i|
            Comparator:
                remain: #{ remain }
                targets: #{ map toString targets }
                sources: #{ map toString sources }
                currentWork: #{ currentWork }
                #{ nest 4 $ pretty process_ }
            |]

instance IOConnected (Comparator v x t) where
    data IOPorts (Comparator v x t) = CompareIO
        deriving (Int -> IOPorts (Comparator v x t) -> ShowS
[IOPorts (Comparator v x t)] -> ShowS
IOPorts (Comparator v x t) -> String
(Int -> IOPorts (Comparator v x t) -> ShowS)
-> (IOPorts (Comparator v x t) -> String)
-> ([IOPorts (Comparator v x t)] -> ShowS)
-> Show (IOPorts (Comparator v x t))
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall v x t. Int -> IOPorts (Comparator v x t) -> ShowS
forall v x t. [IOPorts (Comparator v x t)] -> ShowS
forall v x t. IOPorts (Comparator v x t) -> String
$cshowsPrec :: forall v x t. Int -> IOPorts (Comparator v x t) -> ShowS
showsPrec :: Int -> IOPorts (Comparator v x t) -> ShowS
$cshow :: forall v x t. IOPorts (Comparator v x t) -> String
show :: IOPorts (Comparator v x t) -> String
$cshowList :: forall v x t. [IOPorts (Comparator v x t)] -> ShowS
showList :: [IOPorts (Comparator v x t)] -> ShowS
Show)

instance BreakLoopProblem (Comparator v x t) v x

instance ConstantFoldingProblem (Comparator v x t) v x

instance OptimizeAccumProblem (Comparator v x t) v x

instance ResolveDeadlockProblem (Comparator v x t) v x

instance IOTestBench (Comparator v x t) v x

instance OptimizeLogicalUnitProblem (Comparator v x t) v x

instance VarValTime v x t => TargetSystemComponent (Comparator v x t) where
    moduleName :: Text -> Comparator v x t -> Text
moduleName Text
_ Comparator v x t
_ = String -> Text
T.pack String
"pu_compare"
    software :: Text -> Comparator v x t -> Implementation
software Text
_ Comparator v x t
_ = Implementation
Empty
    hardware :: Text -> Comparator v x t -> Implementation
hardware Text
_tag Comparator v x t
_pu = String -> Implementation
FromLibrary String
"pu_compare.v"

    hardwareInstance :: Text -> Comparator v x t -> UnitEnv (Comparator v x t) -> Verilog
hardwareInstance
        Text
tag
        Comparator v x t
_pu
        UnitEnv
            { Text
sigClk :: Text
sigClk :: forall m. UnitEnv m -> Text
sigClk
            , Text
sigRst :: Text
sigRst :: forall m. UnitEnv m -> Text
sigRst
            , ctrlPorts :: forall m. UnitEnv m -> Maybe (Ports m)
ctrlPorts = Just ComparePorts{[SignalTag]
SignalTag
oePort :: forall v x t. Ports (Comparator v x t) -> SignalTag
wrPort :: forall v x t. Ports (Comparator v x t) -> SignalTag
opSelPort :: forall v x t. Ports (Comparator v x t) -> [SignalTag]
oePort :: SignalTag
wrPort :: SignalTag
opSelPort :: [SignalTag]
..}
            , valueIn :: forall m. UnitEnv m -> Maybe (Text, Text)
valueIn = Just (Text
dataIn, Text
attrIn)
            , valueOut :: forall m. UnitEnv m -> Maybe (Text, Text)
valueOut = Just (Text
dataOut, Text
attrOut)
            } =
            [__i|
            pu_compare \#
                ( .DATA_WIDTH( #{ dataWidth (def :: x) } )
                , .ATTR_WIDTH( #{ attrWidth (def :: x) } )
                , .SEL_WIDTH( #{ selWidth } )
                ) #{ tag } (
            .clk(#{ sigClk }),
            .rst( #{ sigRst } ),
            .oe(#{ oePort }),
            .wr(#{ wrPort }),
            .op_sel({ #{ T.intercalate (T.pack ", ") $ map showText opSelPort } })

            , .data_in( #{ dataIn } )
            , .attr_in( #{ attrIn } )
            , .data_out( #{ dataOut } )
            , .attr_out( #{ attrOut } )
            );
        |]
    hardwareInstance Text
_title Comparator v x t
_pu UnitEnv (Comparator v x t)
_env = String -> Verilog
forall a. HasCallStack => String -> a
error String
"internal error"

instance Ord t => WithFunctions (Comparator v x t) (F v x) where
    functions :: Comparator v x t -> [F v x]
functions Comparator{Process t (StepInfo v x t)
process_ :: forall v x t. Comparator v x t -> Process t (StepInfo v x t)
process_ :: Process t (StepInfo v x t)
process_, [F v x]
remain :: forall v x t. Comparator v x t -> [F v x]
remain :: [F v x]
remain, Maybe (F v x)
currentWork :: forall v x t. Comparator v x t -> Maybe (F v x)
currentWork :: Maybe (F v x)
currentWork} =
        Process t (StepInfo v x t) -> [F v x]
forall a f. WithFunctions a f => a -> [f]
functions Process t (StepInfo v x t)
process_
            [F v x] -> [F v x] -> [F v x]
forall a. [a] -> [a] -> [a]
++ [F v x]
remain
            [F v x] -> [F v x] -> [F v x]
forall a. [a] -> [a] -> [a]
++ Maybe (F v x) -> [F v x]
forall a. Maybe a -> [a]
maybeToList Maybe (F v x)
currentWork

instance VarValTime v x t => Testable (Comparator v x t) v x where
    testBenchImplementation :: Project (Comparator v x t) v x -> Implementation
testBenchImplementation prj :: Project (Comparator v x t) v x
prj@Project{Text
pName :: Text
pName :: forall m v x. Project m v x -> Text
pName, Comparator v x t
pUnit :: Comparator v x t
pUnit :: forall m v x. Project m v x -> m
pUnit} =
        let tbcSignalsConst :: [Text]
tbcSignalsConst = [String -> Text
T.pack String
"oe", String -> Text
T.pack String
"wr", String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
selWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":0] op_sel"]
            showMicrocode :: Microcode (Comparator v x t) -> a
showMicrocode Microcode{Bool
oe :: forall v x t. Microcode (Comparator v x t) -> Bool
oe :: Bool
oe, Bool
wr :: forall v x t. Microcode (Comparator v x t) -> Bool
wr :: Bool
wr, Int
opSel :: forall v x t. Microcode (Comparator v x t) -> Int
opSel :: Int
opSel} =
                [i|oe <= #{ bool2verilog oe };|]
                    a -> a -> a
forall a. Semigroup a => a -> a -> a
<> [i| wr <= #{ bool2verilog wr };|]
                    a -> a -> a
forall a. Semigroup a => a -> a -> a
<> [i| op_sel <= #{ show opSel };|]
         in String -> Text -> Implementation
Immediate (Text -> String
forall a. ToString a => a -> String
toString (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Comparator v x t -> Text
forall pu. TargetSystemComponent pu => Text -> pu -> Text
moduleName Text
pName Comparator v x t
pUnit Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
"_tb.v") (Text -> Implementation) -> Text -> Implementation
forall a b. (a -> b) -> a -> b
$
                Project (Comparator v x t) v x
-> SnippetTestBenchConf (Comparator v x t) -> Text
forall m v x t.
(WithFunctions m (F v x), ProcessorUnit m v x t,
 TargetSystemComponent m, UnambiguouslyDecode m, Typeable m,
 Show (Instruction m), Default (Microcode m)) =>
Project m v x -> SnippetTestBenchConf m -> Text
snippetTestBench
                    Project (Comparator v x t) v x
prj
                    SnippetTestBenchConf
                        { tbcSignals :: [Text]
tbcSignals = [Text]
tbcSignalsConst
                        , tbcPorts :: Ports (Comparator v x t)
tbcPorts =
                            ComparePorts
                                { oePort :: SignalTag
oePort = Text -> SignalTag
SignalTag (String -> Text
T.pack String
"oe")
                                , wrPort :: SignalTag
wrPort = Text -> SignalTag
SignalTag (String -> Text
T.pack String
"wr")
                                , opSelPort :: [SignalTag]
opSelPort =
                                    [ (Text -> SignalTag
SignalTag (Text -> SignalTag) -> (String -> Text) -> String -> SignalTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) (String
"op_sel[" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]")
                                    | Int
p <- [Int
selWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Int
selWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2 .. Int
0]
                                    ]
                                }
                        , tbcMC2verilogLiteral :: Microcode (Comparator v x t) -> Text
tbcMC2verilogLiteral = Microcode (Comparator v x t) -> Text
forall {a} {v} {x} {t}.
(Semigroup a, Interpolatable (IsCustomSink a) String a,
 Interpolatable (IsCustomSink a) Text a) =>
Microcode (Comparator v x t) -> a
showMicrocode
                        }