{-# 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 = forall a. Maybe a
Nothing
        , process_ :: Process t (StepInfo v x t)
process_ = 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 :: [F v x]
remain :: forall v x t. Comparator v x t -> [F v x]
remain}
        | Just F.Compare{} <- forall (f :: * -> * -> *) v x.
(Typeable f, Typeable v, Typeable x) =>
F v x -> Maybe (f v x)
castF F v x
f =
            forall a b. b -> Either a b
Right
                Comparator v x t
pu
                    { remain :: [F v x]
remain = F v x
f forall a. a -> [a] -> [a]
: [F v x]
remain
                    }
        | Bool
otherwise = 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 = 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
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
showList :: [Ports (Comparator v x t)] -> ShowS
$cshowList :: forall v x t. [Ports (Comparator v x t)] -> ShowS
show :: Ports (Comparator v x t) -> String
$cshow :: forall v x t. Ports (Comparator v x t) -> String
showsPrec :: Int -> Ports (Comparator v x t) -> ShowS
$cshowsPrec :: forall v x t. Int -> Ports (Comparator v x t) -> ShowS
Show)

supportedOpsNum :: Int
supportedOpsNum :: Int
supportedOpsNum = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length (DataType -> [Constr]
dataTypeConstrs forall a b. (a -> b) -> a -> b
$ forall a. Data a => a -> DataType
dataTypeOf CmpOp
F.CmpEq)
selWidth :: Int
selWidth = forall a b. (RealFrac a, Integral b) => a -> b
ceiling (forall a. Floating a => a -> a -> a
logBase Double
2 (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
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
showList :: [Instruction (Comparator v x t)] -> ShowS
$cshowList :: forall v x t. [Instruction (Comparator v x t)] -> ShowS
show :: Instruction (Comparator v x t) -> String
$cshow :: forall v x t. Instruction (Comparator v x t) -> String
showsPrec :: Int -> Instruction (Comparator v x t) -> ShowS
$cshowsPrec :: forall v x t. Int -> 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
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
showList :: [Microcode (Comparator v x t)] -> ShowS
$cshowList :: forall v x t. [Microcode (Comparator v x t)] -> ShowS
show :: Microcode (Comparator v x t) -> String
$cshow :: forall v x t. Microcode (Comparator v x t) -> String
showsPrec :: Int -> Microcode (Comparator v x t) -> ShowS
$cshowsPrec :: forall v x t. Int -> Microcode (Comparator v x t) -> ShowS
Show, Microcode (Comparator v x t)
-> Microcode (Comparator v x t) -> Bool
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
/= :: 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
Eq)

    zipSignalTagsAndValues :: Ports (Comparator v x t)
-> Microcode (Comparator v x t) -> [(SignalTag, SignalValue)]
zipSignalTagsAndValues ComparePorts{[SignalTag]
SignalTag
opSelPort :: [SignalTag]
wrPort :: SignalTag
oePort :: SignalTag
opSelPort :: forall v x t. Ports (Comparator v x t) -> [SignalTag]
wrPort :: forall v x t. Ports (Comparator v x t) -> SignalTag
oePort :: forall v x t. Ports (Comparator v x t) -> SignalTag
..} Microcode{Bool
Int
opSel :: Int
wr :: Bool
oe :: Bool
opSel :: forall v x t. Microcode (Comparator v x t) -> Int
wr :: forall v x t. Microcode (Comparator v x t) -> Bool
oe :: forall v x t. Microcode (Comparator v x t) -> Bool
..} =
        [ (SignalTag
oePort, Bool -> SignalValue
Bool Bool
oe)
        , (SignalTag
wrPort, Bool -> SignalValue
Bool Bool
wr)
        ]
            forall a. [a] -> [a] -> [a]
++ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\SignalTag
tag Bool
bit -> (SignalTag
tag, Bool -> SignalValue
Bool Bool
bit)) [SignalTag]
opSelPort (forall {a}. Bits a => a -> Int -> [Bool]
bits Int
opSel Int
selWidth)
        where
            bits :: a -> Int -> [Bool]
bits a
val Int
localWidth = [forall a. Bits a => a -> Int -> Bool
testBit a
val (Int
localWidth forall a. Num a => a -> a -> a
- Int
idx forall a. Num a => a -> a -> a
- Int
1) | Int
idx <- [Int
0 .. Int
localWidth forall a. Num a => a -> a -> a
- Int
1]]
    usedPortTags :: Ports (Comparator v x t) -> [SignalTag]
usedPortTags ComparePorts{SignalTag
oePort :: SignalTag
oePort :: forall v x t. Ports (Comparator v x t) -> SignalTag
oePort, SignalTag
wrPort :: SignalTag
wrPort :: forall v x t. Ports (Comparator v x t) -> SignalTag
wrPort, [SignalTag]
opSelPort :: [SignalTag]
opSelPort :: forall v x t. Ports (Comparator v x t) -> [SignalTag]
opSelPort} = SignalTag
oePort forall a. a -> [a] -> [a]
: SignalTag
wrPort 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
_ = forall v x t.
SignalTag -> SignalTag -> [SignalTag] -> Ports (Comparator v x t)
ComparePorts SignalTag
oe SignalTag
wr [SignalTag]
sel
        where
            sel :: [SignalTag]
sel = forall a. Int -> [a] -> [a]
take Int
selWidth [SignalTag]
xs
    takePortTags [SignalTag]
_ 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 :: [F v x]
remain :: forall v x t. Comparator v x t -> [F v x]
remain, [v]
sources :: [v]
sources :: forall v x t. Comparator v x t -> [v]
sources, [v]
targets :: [v]
targets :: forall v x t. Comparator v x t -> [v]
targets} =
        [ Lock{v
lockBy :: v
lockBy :: v
lockBy, v
locked :: v
locked :: v
locked}
        | v
locked <- [v]
sources
        , v
lockBy <- [v]
targets
        ]
            forall a. [a] -> [a] -> [a]
++ [ Lock{v
lockBy :: v
lockBy :: v
lockBy, v
locked :: v
locked :: v
locked}
               | v
locked <- forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. Set a -> [a]
S.elems forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a v. Variables a v => a -> Set v
variables) [F v x]
remain
               , v
lockBy <- [v]
sources forall a. [a] -> [a] -> [a]
++ [v]
targets
               ]
            forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap 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 = forall a. Default a => a
def{oe :: Bool
oe = Bool
True}
    decodeInstruction (Load CmpOp
op) = case CmpOp
op of
        CmpOp
F.CmpEq -> forall a. Default a => a
def{opSel :: Int
opSel = Int
0, wr :: Bool
wr = Bool
True}
        CmpOp
F.CmpLt -> forall a. Default a => a
def{opSel :: Int
opSel = Int
1, wr :: Bool
wr = Bool
True}
        CmpOp
F.CmpLte -> forall a. Default a => a
def{opSel :: Int
opSel = Int
2, wr :: Bool
wr = Bool
True}
        CmpOp
F.CmpGt -> forall a. Default a => a
def{opSel :: Int
opSel = Int
3, wr :: Bool
wr = Bool
True}
        CmpOp
F.CmpGte -> forall a. Default a => a
def{opSel :: Int
opSel = Int
4, wr :: Bool
wr = Bool
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 = 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]
_} =
        [forall v tp. EndpointRole v -> tp -> EndpointSt v tp
EndpointSt (forall v. v -> EndpointRole v
Target v
target) forall a b. (a -> b) -> a -> b
$ forall t. Interval t -> Interval t -> TimeConstraint t
TimeConstraint Interval t
at Interval t
duration]
        where
            at :: Interval t
at = forall u t. NextTick u t => u -> t
nextTick Comparator v x t
pu forall a. Ord a => a -> a -> Interval a
... forall a. Bounded a => a
maxBound
            duration :: Interval t
duration = t
1 forall a. Ord a => a -> a -> Interval a
... 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_ :: Process t (StepInfo v x t)
process_ :: forall v x t. Comparator v x t -> Process t (StepInfo v x t)
process_
            } = [forall v tp. EndpointRole v -> tp -> EndpointSt v tp
EndpointSt (forall v. Set v -> EndpointRole v
Source forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
S.fromList (forall v x t. Comparator v x t -> [v]
sources Comparator v x t
pu)) forall a b. (a -> b) -> a -> b
$ forall t. Interval t -> Interval t -> TimeConstraint t
TimeConstraint Interval t
at Interval t
duration]
            where
                doneAt :: t
doneAt = 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 forall a. Num a => a -> a -> a
+ t
3
                at :: Interval t
at = forall a. Ord a => a -> a -> a
max t
doneAt (forall u t. NextTick u t => u -> t
nextTick Process t (StepInfo v x t)
process_) forall a. Ord a => a -> a -> Interval a
... forall a. Bounded a => a
maxBound
                duration :: Interval t
duration = t
1 forall a. Ord a => a -> a -> Interval a
... forall a. Bounded a => a
maxBound
    endpointOptions pu :: Comparator v x t
pu@Comparator{[F v x]
remain :: [F v x]
remain :: forall v x t. Comparator v x t -> [F v x]
remain} =
        forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall u v t.
EndpointProblem u v t =>
u -> [EndpointSt v (TimeConstraint t)]
endpointOptions forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: [v]
targets :: forall v x t. Comparator v x t -> [v]
targets, Maybe (F v x)
currentWork :: Maybe (F v x)
currentWork :: forall v x t. Comparator v x t -> 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 :: forall v tp. EndpointSt v tp -> tp
epAt :: Interval t
epAt}
        | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [v]
targets
        , ([v
_], [v]
targets') <- forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (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_' = 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 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
_) <- 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 forall a. Eq a => a -> a -> Bool
== v
a then CmpOp
op else CmpOp -> CmpOp
flipCmpOp CmpOp
op
                             in 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 forall a b. (a -> b) -> a -> b
$ forall {pu} {v} {x} {t} {m :: * -> *}.
(MonadState (Schedule pu v x t) m, Show (Instruction pu),
 Typeable pu, Num t) =>
Interval t -> Instruction pu -> m [Int]
scheduleInstructionUnsafe Interval t
epAt (forall v x t. CmpOp -> Instruction (Comparator v x t)
Load CmpOp
adjustedOp)
                        | Bool
otherwise -> forall a. HasCallStack => String -> a
error String
"Unsupported function type for Comparator"
                    Maybe (F v x)
Nothing -> forall a. HasCallStack => String -> a
error String
"cmpOp is Nothing" =
            Comparator v x t
pu
                { process_ :: Process t (StepInfo v x t)
process_ = Process t (StepInfo v x t)
process_'
                , -- The remainder of the work is saved for the next loop
                  targets :: [v]
targets = [v]
targets'
                }
    endpointDecision pu :: Comparator v x t
pu@Comparator{targets :: forall v x t. Comparator v x t -> [v]
targets = [], [v]
sources :: [v]
sources :: forall v x t. Comparator v x t -> [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_ :: Process t (StepInfo v x t)
process_ :: forall v x t. Comparator v x t -> 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 :: Interval t
epAt :: forall v tp. EndpointSt v tp -> tp
epAt}
        | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [v]
sources
        , let sources' :: [v]
sources' = [v]
sources forall a. Eq a => [a] -> [a] -> [a]
\\ forall a. Set a -> [a]
S.elems Set v
v
        , [v]
sources' forall a. Eq a => a -> a -> Bool
/= [v]
sources
        , let a :: t
a = forall a. Interval a -> a
inf forall a b. (a -> b) -> a -> b
$ forall {a} {i}. Ord a => [Step a i] -> Interval a
stepsInterval forall a b. (a -> b) -> a -> b
$ 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_ forall a b. (a -> b) -> a -> b
$ 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_' = 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 forall a b. (a -> b) -> a -> b
$ do
                [Int]
endpoints <- 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 forall a b. (a -> b) -> a -> b
$ forall {pu} {v} {x} {t} {m :: * -> *}.
(MonadState (Schedule pu v x t) m, Show (Instruction pu),
 Typeable pu, Num t) =>
Interval t -> Instruction pu -> m [Int]
scheduleInstructionUnsafe Interval t
epAt forall v x t. Instruction (Comparator v x t)
Out
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [v]
sources') forall a b. (a -> b) -> a -> b
$ do
                    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 forall a b. (a -> b) -> a -> b
$ t
a forall a. Ord a => a -> a -> Interval a
... forall a. Interval a -> a
sup Interval t
epAt
                forall (m :: * -> *) a. Monad m => a -> m a
return [Int]
endpoints =
            Comparator v x t
pu
                { process_ :: Process t (StepInfo v x t)
process_ = Process t (StepInfo v x t)
process_'
                , -- In case if not all variables what asked - remaining are saved.
                  sources :: [v]
sources = [v]
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 :: Maybe (F v x)
currentWork = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [v]
sources' then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just F v x
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 :: [F v x]
remain :: forall v x t. Comparator v x t -> [F v x]
remain} EndpointSt v (Interval t)
d
        | let v :: v
v = forall {c}. Set c -> c
oneOf forall a b. (a -> b) -> a -> b
$ forall a v. Variables a v => a -> Set v
variables EndpointSt v (Interval t)
d
        , Just F v x
f <- forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\F v x
f -> v
v forall a. Ord a => a -> Set a -> Bool
`S.member` forall a v. Variables a v => a -> Set v
variables F v x
f) [F v x]
remain =
            forall u v t.
EndpointProblem u v t =>
u -> EndpointSt v (Interval t) -> u
endpointDecision (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 = 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 :: [F v x]
remain :: forall v x t. Comparator v x t -> [F v x]
remain} F v x
f
    | Just (F.Compare CmpOp
_ (I v
a) (I v
b) (O Set v
c)) <- 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 :: [v]
targets = [v
a, v
b]
            , currentWork :: Maybe (F v x)
currentWork = forall a. a -> Maybe a
Just F v x
f
            , sources :: [v]
sources = forall a. Set a -> [a]
S.elems Set v
c
            , remain :: [F v x]
remain = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= F v x
f) [F v x]
remain
            }
execution Comparator v x t
_ F v x
f =
    forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$
        String
"Comparator: internal execution error. Expected Compare, got: " forall a. [a] -> [a] -> [a]
++ 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 :: [F v x]
remain :: forall v x t. Comparator v x t -> [F v x]
remain, [v]
targets :: [v]
targets :: forall v x t. Comparator v x t -> [v]
targets, [v]
sources :: [v]
sources :: forall v x t. Comparator v x t -> [v]
sources, Maybe (F v x)
currentWork :: Maybe (F v x)
currentWork :: forall v x t. Comparator v x t -> Maybe (F v x)
currentWork, Process t (StepInfo v x t)
process_ :: Process t (StepInfo v x t)
process_ :: forall v x t. Comparator v x t -> 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
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
showList :: [IOPorts (Comparator v x t)] -> ShowS
$cshowList :: forall v x t. [IOPorts (Comparator v x t)] -> ShowS
show :: IOPorts (Comparator v x t) -> String
$cshow :: forall v x t. IOPorts (Comparator v x t) -> String
showsPrec :: Int -> IOPorts (Comparator v x t) -> ShowS
$cshowsPrec :: forall v x t. Int -> 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 :: forall m. UnitEnv m -> Text
sigClk :: Text
sigClk
            , Text
sigRst :: forall m. UnitEnv m -> Text
sigRst :: Text
sigRst
            , ctrlPorts :: forall m. UnitEnv m -> Maybe (Ports m)
ctrlPorts = Just ComparePorts{[SignalTag]
SignalTag
opSelPort :: [SignalTag]
wrPort :: SignalTag
oePort :: SignalTag
opSelPort :: forall v x t. Ports (Comparator v x t) -> [SignalTag]
wrPort :: forall v x t. Ports (Comparator v x t) -> SignalTag
oePort :: forall v x t. Ports (Comparator v x t) -> 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 = 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_ :: Process t (StepInfo v x t)
process_ :: forall v x t. Comparator v x t -> Process t (StepInfo v x t)
process_, [F v x]
remain :: [F v x]
remain :: forall v x t. Comparator v x t -> [F v x]
remain, Maybe (F v x)
currentWork :: Maybe (F v x)
currentWork :: forall v x t. Comparator v x t -> Maybe (F v x)
currentWork} =
        forall a f. WithFunctions a f => a -> [f]
functions Process t (StepInfo v x t)
process_
            forall a. [a] -> [a] -> [a]
++ [F v x]
remain
            forall a. [a] -> [a] -> [a]
++ 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 :: forall m v x. Project m v x -> Text
pName :: Text
pName, Comparator v x t
pUnit :: forall m v x. Project m v x -> m
pUnit :: Comparator v x t
pUnit} =
        let tbcSignalsConst :: [Text]
tbcSignalsConst = [String -> Text
T.pack String
"oe", String -> Text
T.pack String
"wr", String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"[" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Int
selWidth forall a. Num a => a -> a -> a
- Int
1) forall a. [a] -> [a] -> [a]
++ String
":0] op_sel"]
            showMicrocode :: Microcode (Comparator v x t) -> a
showMicrocode Microcode{Bool
oe :: Bool
oe :: forall v x t. Microcode (Comparator v x t) -> Bool
oe, Bool
wr :: Bool
wr :: forall v x t. Microcode (Comparator v x t) -> Bool
wr, Int
opSel :: Int
opSel :: forall v x t. Microcode (Comparator v x t) -> Int
opSel} =
                [i|oe <= #{ bool2verilog oe };|]
                    forall a. Semigroup a => a -> a -> a
<> [i| wr <= #{ bool2verilog wr };|]
                    forall a. Semigroup a => a -> a -> a
<> [i| op_sel <= #{ show opSel };|]
         in String -> Text -> Implementation
Immediate (forall a. ToString a => a -> String
toString forall a b. (a -> b) -> a -> b
$ forall pu. TargetSystemComponent pu => Text -> pu -> Text
moduleName Text
pName Comparator v x t
pUnit forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
"_tb.v") forall a b. (a -> b) -> a -> b
$
                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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) (String
"op_sel[" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
p forall a. Semigroup a => a -> a -> a
<> String
"]")
                                    | Int
p <- [Int
selWidth forall a. Num a => a -> a -> a
- Int
1, Int
selWidth forall a. Num a => a -> a -> a
- Int
2 .. Int
0]
                                    ]
                                }
                        , tbcMC2verilogLiteral :: Microcode (Comparator v x t) -> Text
tbcMC2verilogLiteral = forall {a} {v} {x} {t}.
(Builder (IsCustomSink a) a ~ Builder (IsCustomSink a) a,
 Semigroup a, Interpolatable (IsCustomSink a) String a,
 Interpolatable (IsCustomSink a) Text a) =>
Microcode (Comparator v x t) -> a
showMicrocode
                        }