{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}

{- |
Module      : NITTA.Model.ProcessorUnits.Types
Description : Set of types for process unit description
Copyright   : (c) Aleksandr Penskoi, 2021
License     : BSD3
Maintainer  : aleksandr.penskoi@gmail.com
Stability   : experimental
-}
module NITTA.Model.ProcessorUnits.Types (
    -- * Processor unit
    UnitTag (..),
    ProcessorUnit (..),
    bind,
    allowToProcess,
    NextTick (..),
    ParallelismType (..),

    -- * Process description
    Process (..),
    ProcessStepID,
    Step (..),
    StepInfo (..),
    Relation (..),
    descent,
    whatsHappen,
    extractInstructionAt,
    withShift,
    isRefactorStep,
    isAllocationStep,

    -- * Control
    Controllable (..),
    SignalTag (..),
    UnambiguouslyDecode (..),
    Connected (..),
    ByTime (..),
    SignalValue (..),
    (+++),

    -- * IO
    IOConnected (..),
    InputPortTag (..),
    OutputPortTag (..),
    InoutPortTag (..),
) where

import Data.Aeson (ToJSON)
import Data.Default
import Data.Either
import Data.Kind
import Data.List qualified as L
import Data.List.Utils (replace)
import Data.Maybe
import Data.Set qualified as S
import Data.String
import Data.String.Interpolate
import Data.String.ToString
import Data.Text qualified as T
import Data.Typeable
import GHC.Generics (Generic)
import NITTA.Intermediate.Types
import NITTA.Model.Problems.Endpoint
import NITTA.Model.Time
import Numeric.Interval.NonEmpty
import Numeric.Interval.NonEmpty qualified as I
import Prettyprinter

-- | Class for processor unit tag or "name"
class (Typeable tag, Ord tag, ToString tag, IsString tag, Semigroup tag) => UnitTag tag where
    -- | Whether the value can be used as a template or not
    isTemplate :: tag -> Bool

    -- | Create tag from the template and index
    fromTemplate :: tag -> String -> tag

instance UnitTag T.Text where
    isTemplate :: Text -> Bool
isTemplate Text
tag = Text -> Text -> Bool
T.isInfixOf (String -> Text
T.pack String
"{x}") Text
tag
    fromTemplate :: Text -> String -> Text
fromTemplate Text
tag String
index = Text -> Text -> Text -> Text
T.replace (String -> Text
T.pack String
"{x}") (String -> Text
T.pack String
index) Text
tag

instance UnitTag String where
    isTemplate :: String -> Bool
isTemplate String
tag = String
"{x}" forall a. Eq a => [a] -> [a] -> Bool
`L.isInfixOf` String
tag
    fromTemplate :: String -> String -> String
fromTemplate String
tag String
index = forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace String
"{x}" String
index String
tag

-- | Processor unit parallelism type
data ParallelismType
    = -- | All operations can be performed in parallel mode
      Full
    | -- | All operations can be performed in pipeline mode
      Pipeline
    | -- | Other processor units
      None
    deriving (ProcessStepID -> ParallelismType -> String -> String
[ParallelismType] -> String -> String
ParallelismType -> String
forall a.
(ProcessStepID -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ParallelismType] -> String -> String
$cshowList :: [ParallelismType] -> String -> String
show :: ParallelismType -> String
$cshow :: ParallelismType -> String
showsPrec :: ProcessStepID -> ParallelismType -> String -> String
$cshowsPrec :: ProcessStepID -> ParallelismType -> String -> String
Show, forall x. Rep ParallelismType x -> ParallelismType
forall x. ParallelismType -> Rep ParallelismType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ParallelismType x -> ParallelismType
$cfrom :: forall x. ParallelismType -> Rep ParallelismType x
Generic, ParallelismType -> ParallelismType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParallelismType -> ParallelismType -> Bool
$c/= :: ParallelismType -> ParallelismType -> Bool
== :: ParallelismType -> ParallelismType -> Bool
$c== :: ParallelismType -> ParallelismType -> Bool
Eq)

instance ToJSON ParallelismType

{- | Process unit - part of NITTA process with can execute a function from
intermediate representation:

1. get function for execution ('tryBind');

2. store computational process description ('process');

3. other features implemented by different type classes (see above and in
   "NITTA.Model.Problems").
-}
class VarValTime v x t => ProcessorUnit u v x t | u -> v x t where
    -- If the processor unit can execute a function, then it will return the PU
    -- model with already bound function (only registeration, actual scheduling
    -- will be happening later). If not, it will return @Left@ value with a
    -- specific reason (e.g., not support or all internal resources is over).
    tryBind :: F v x -> u -> Either String u

    -- Get a computational process description. If the processor unit embedded
    -- another PUs (like "NITTA.Model.Networks.Bus"), the description should
    -- contain process steps for all PUs.
    --
    -- 'ProcessStepID' may change from one call to another.
    process :: u -> Process t (StepInfo v x t)

    -- | Indicates what type of parallelism is supported by 'ProcessorUnit'
    parallelismType :: u -> ParallelismType
    parallelismType u
_ = ParallelismType
None

    -- | Provide the processor unit size. At the moment it's just the number of subprocessors
    puSize :: u -> Float
    puSize u
_ = Float
1

bind :: F v x -> u -> u
bind F v x
f u
pu = case forall u v x t.
ProcessorUnit u v x t =>
F v x -> u -> Either String u
tryBind F v x
f u
pu of
    Right u
pu' -> u
pu'
    Left String
err -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"can't bind function: " forall a. Semigroup a => a -> a -> a
<> String
err

allowToProcess :: F v x -> b -> Bool
allowToProcess F v x
f b
pu = forall a b. Either a b -> Bool
isRight forall a b. (a -> b) -> a -> b
$ forall u v x t.
ProcessorUnit u v x t =>
F v x -> u -> Either String u
tryBind F v x
f b
pu

class NextTick u t | u -> t where
    nextTick :: u -> t

instance ProcessorUnit u v x t => NextTick u t where
    nextTick :: u -> t
nextTick = forall u t. NextTick u t => u -> t
nextTick forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall u v x t.
ProcessorUnit u v x t =>
u -> Process t (StepInfo v x t)
process

---------------------------------------------------------------------

{- | Computational process description. It was designed in ISO 15926 style, with
separated data and relations storage.
-}
data Process t i = Process
    { forall t i. Process t i -> [Step t i]
steps :: [Step t i]
    -- ^ All process steps desctiption.
    , forall t i. Process t i -> [Relation]
relations :: [Relation]
    -- ^ List of relationships between process steps (see 'Relation').
    , forall t i. Process t i -> t
nextTick_ :: t
    -- ^ Next tick for instruction. Note: instruction /= endpoint.
    , forall t i. Process t i -> ProcessStepID
nextUid :: ProcessStepID
    -- ^ Next process step ID
    }
    deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall t i x. Rep (Process t i) x -> Process t i
forall t i x. Process t i -> Rep (Process t i) x
$cto :: forall t i x. Rep (Process t i) x -> Process t i
$cfrom :: forall t i x. Process t i -> Rep (Process t i) x
Generic)

instance (Time t, Show i) => Pretty (Process t i) where
    pretty :: forall ann. Process t i -> Doc ann
pretty Process t i
p =
        [__i|
            Process:
                steps: #{ showList' $ reverse $ steps p }
                relations: #{ showList' $ relations p }
                nextTick: #{ nextTick p }
                nextUid: #{ nextUid p }
        |]
        where
            showList' :: [src] -> Doc ann
showList' [] = forall a ann. Pretty a => a -> Doc ann
pretty String
""
            showList' [src]
xs = forall ann. Doc ann
line forall a. Semigroup a => a -> a -> a
<> forall ann. ProcessStepID -> Doc ann -> Doc ann
indent ProcessStepID
8 (forall ann. [Doc ann] -> Doc ann
vsep [Doc ann]
lst)
                where
                    lst :: [Doc ann]
lst =
                        forall a b. (a -> b) -> [a] -> [b]
map (forall a ann. Pretty a => a -> Doc ann
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(ProcessStepID
ix, src
value) -> [i|#{ ix }) #{ value }|] :: T.Text)) forall a b. (a -> b) -> a -> b
$
                            forall a b. [a] -> [b] -> [(a, b)]
zip [ProcessStepID
0 :: Int ..] [src]
xs

instance (ToJSON t, ToJSON i) => ToJSON (Process t i)

instance Default t => Default (Process t i) where
    def :: Process t i
def = Process{steps :: [Step t i]
steps = [], relations :: [Relation]
relations = [], nextTick_ :: t
nextTick_ = forall a. Default a => a
def, nextUid :: ProcessStepID
nextUid = forall a. Default a => a
def}

instance {-# OVERLAPS #-} NextTick (Process t si) t where
    nextTick :: Process t si -> t
nextTick = forall t i. Process t i -> t
nextTick_

instance Ord t => WithFunctions (Process t (StepInfo v x t)) (F v x) where
    functions :: Process t (StepInfo v x t) -> [F v x]
functions Process{[Step t (StepInfo v x t)]
steps :: [Step t (StepInfo v x t)]
steps :: forall t i. Process t i -> [Step t i]
steps} = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {t} {v} {x} {t}. Step t (StepInfo v x t) -> Maybe (F v x)
get forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> [a] -> [a]
L.sortOn (forall a. Interval a -> a
I.inf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t i. Step t i -> Interval t
pInterval) [Step t (StepInfo v x t)]
steps
        where
            get :: Step t (StepInfo v x t) -> Maybe (F v x)
get Step{StepInfo v x t
pDesc :: forall t i. Step t i -> i
pDesc :: StepInfo v x t
pDesc} | IntermediateStep F v x
f <- forall {v} {x} {t}. StepInfo v x t -> StepInfo v x t
descent StepInfo v x t
pDesc = forall a. a -> Maybe a
Just F v x
f
            get Step t (StepInfo v x t)
_ = forall a. Maybe a
Nothing

-- | Unique ID of a process step. Uniquity presented only inside PU.
type ProcessStepID = Int

-- | Process step representation
data Step t i = Step
    { forall t i. Step t i -> ProcessStepID
pID :: ProcessStepID
    -- ^ uniq (inside single the process unit) step ID
    , forall t i. Step t i -> Interval t
pInterval :: Interval t
    -- ^ step time
    , forall t i. Step t i -> i
pDesc :: i
    -- ^ step description
    }
    deriving (ProcessStepID -> Step t i -> String -> String
forall a.
(ProcessStepID -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
forall t i.
(Show t, Show i) =>
ProcessStepID -> Step t i -> String -> String
forall t i. (Show t, Show i) => [Step t i] -> String -> String
forall t i. (Show t, Show i) => Step t i -> String
showList :: [Step t i] -> String -> String
$cshowList :: forall t i. (Show t, Show i) => [Step t i] -> String -> String
show :: Step t i -> String
$cshow :: forall t i. (Show t, Show i) => Step t i -> String
showsPrec :: ProcessStepID -> Step t i -> String -> String
$cshowsPrec :: forall t i.
(Show t, Show i) =>
ProcessStepID -> Step t i -> String -> String
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall t i x. Rep (Step t i) x -> Step t i
forall t i x. Step t i -> Rep (Step t i) x
$cto :: forall t i x. Rep (Step t i) x -> Step t i
$cfrom :: forall t i x. Step t i -> Rep (Step t i) x
Generic)

instance (ToJSON t, ToJSON i) => ToJSON (Step t i)

instance Ord v => Patch (Step t (StepInfo v x t)) (Changeset v) where
    patch :: Changeset v -> Step t (StepInfo v x t) -> Step t (StepInfo v x t)
patch Changeset v
diff step :: Step t (StepInfo v x t)
step@Step{StepInfo v x t
pDesc :: StepInfo v x t
pDesc :: forall t i. Step t i -> i
pDesc} = Step t (StepInfo v x t)
step{pDesc :: StepInfo v x t
pDesc = forall f diff. Patch f diff => diff -> f -> f
patch Changeset v
diff StepInfo v x t
pDesc}

-- | Informative process step description at a specific process level.
data StepInfo v x t where
    -- | CAD level step
    CADStep :: String -> StepInfo v x t
    -- | Apply refactoring
    RefactorStep :: (Typeable ref, Show ref, Eq ref) => ref -> StepInfo v x t
    -- | intermidiate level step (function execution)
    IntermediateStep :: F v x -> StepInfo v x t
    -- | endpoint level step (source or target)
    EndpointRoleStep :: EndpointRole v -> StepInfo v x t
    -- | process unit instruction (depends on process unit type)
    InstructionStep ::
        (Show (Instruction pu), Typeable (Instruction pu)) =>
        Instruction pu ->
        StepInfo v x t
    -- | wrapper for nested process unit step (used for networks)
    NestedStep :: UnitTag tag => {()
nTitle :: tag, forall t v x. StepInfo v x t -> Step t (StepInfo v x t)
nStep :: Step t (StepInfo v x t)} -> StepInfo v x t
    -- | Process unit allocation step
    AllocationStep :: (Typeable a, Show a, Eq a) => a -> StepInfo v x t

descent :: StepInfo v x t -> StepInfo v x t
descent (NestedStep tag
_ Step t (StepInfo v x t)
step) = StepInfo v x t -> StepInfo v x t
descent forall a b. (a -> b) -> a -> b
$ forall t i. Step t i -> i
pDesc Step t (StepInfo v x t)
step
descent StepInfo v x t
desc = StepInfo v x t
desc

isRefactorStep :: StepInfo v x t -> Bool
isRefactorStep RefactorStep{} = Bool
True
isRefactorStep StepInfo v x t
_ = Bool
False

isAllocationStep :: StepInfo v x t -> Bool
isAllocationStep AllocationStep{} = Bool
True
isAllocationStep StepInfo v x t
_ = Bool
False

instance (Var v, Show (Step t (StepInfo v x t))) => Show (StepInfo v x t) where
    show :: StepInfo v x t -> String
show (CADStep String
msg) = String
"CAD: " forall a. Semigroup a => a -> a -> a
<> String
msg
    show (AllocationStep a
alloc) = String
"Allocation: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show a
alloc
    show (RefactorStep ref
ref) = String
"Refactor: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ref
ref
    show (IntermediateStep F{f
fun :: ()
fun :: f
fun}) = String
"Intermediate: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show f
fun
    show (EndpointRoleStep EndpointRole v
eff) = String
"Endpoint: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show EndpointRole v
eff
    show (InstructionStep Instruction pu
instr) = String
"Instruction: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Instruction pu
instr
    show NestedStep{tag
nTitle :: tag
nTitle :: ()
nTitle, nStep :: forall t v x. StepInfo v x t -> Step t (StepInfo v x t)
nStep = Step{StepInfo v x t
pDesc :: StepInfo v x t
pDesc :: forall t i. Step t i -> i
pDesc}} = String
"@" forall a. Semigroup a => a -> a -> a
<> forall a. ToString a => a -> String
toString tag
nTitle forall a. Semigroup a => a -> a -> a
<> String
" " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show StepInfo v x t
pDesc

instance Ord v => Patch (StepInfo v x t) (Changeset v) where
    patch :: Changeset v -> StepInfo v x t -> StepInfo v x t
patch Changeset v
diff (IntermediateStep F v x
f) = forall v x t. F v x -> StepInfo v x t
IntermediateStep forall a b. (a -> b) -> a -> b
$ forall f diff. Patch f diff => diff -> f -> f
patch Changeset v
diff F v x
f
    patch Changeset v
diff (EndpointRoleStep EndpointRole v
ep) = forall v x t. EndpointRole v -> StepInfo v x t
EndpointRoleStep forall a b. (a -> b) -> a -> b
$ forall f diff. Patch f diff => diff -> f -> f
patch Changeset v
diff EndpointRole v
ep
    patch Changeset v
diff (NestedStep tag
tag Step t (StepInfo v x t)
nStep) = forall tag t v x.
UnitTag tag =>
tag -> Step t (StepInfo v x t) -> StepInfo v x t
NestedStep tag
tag forall a b. (a -> b) -> a -> b
$ forall f diff. Patch f diff => diff -> f -> f
patch Changeset v
diff Step t (StepInfo v x t)
nStep
    patch Changeset v
_ StepInfo v x t
instr = StepInfo v x t
instr

-- | Relations between process steps.
data Relation
    = {- | Vertical relationships (up and down). For example, the intermediate
      step (function execution) can be translated to a sequence of endpoint
      steps (receiving and sending variable), and process unit instructions.
      -}
      Vertical {Relation -> ProcessStepID
vUp, Relation -> ProcessStepID
vDown :: ProcessStepID}
    | {- | Horizontal relationships (on one level). For example, we bind the
      function and apply the refactoring. The binding step should be
      connected to refactoring steps, including new binding steps.
      -}
      Horizontal {Relation -> ProcessStepID
hPrev, Relation -> ProcessStepID
hNext :: ProcessStepID}
    deriving (ProcessStepID -> Relation -> String -> String
[Relation] -> String -> String
Relation -> String
forall a.
(ProcessStepID -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Relation] -> String -> String
$cshowList :: [Relation] -> String -> String
show :: Relation -> String
$cshow :: Relation -> String
showsPrec :: ProcessStepID -> Relation -> String -> String
$cshowsPrec :: ProcessStepID -> Relation -> String -> String
Show, forall x. Rep Relation x -> Relation
forall x. Relation -> Rep Relation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Relation x -> Relation
$cfrom :: forall x. Relation -> Rep Relation x
Generic, Eq Relation
Relation -> Relation -> Bool
Relation -> Relation -> Ordering
Relation -> Relation -> Relation
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Relation -> Relation -> Relation
$cmin :: Relation -> Relation -> Relation
max :: Relation -> Relation -> Relation
$cmax :: Relation -> Relation -> Relation
>= :: Relation -> Relation -> Bool
$c>= :: Relation -> Relation -> Bool
> :: Relation -> Relation -> Bool
$c> :: Relation -> Relation -> Bool
<= :: Relation -> Relation -> Bool
$c<= :: Relation -> Relation -> Bool
< :: Relation -> Relation -> Bool
$c< :: Relation -> Relation -> Bool
compare :: Relation -> Relation -> Ordering
$ccompare :: Relation -> Relation -> Ordering
Ord, Relation -> Relation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Relation -> Relation -> Bool
$c/= :: Relation -> Relation -> Bool
== :: Relation -> Relation -> Bool
$c== :: Relation -> Relation -> Bool
Eq)

instance ToJSON Relation

whatsHappen :: a -> Process a i -> [Step a i]
whatsHappen a
t Process{[Step a i]
steps :: [Step a i]
steps :: forall t i. Process t i -> [Step t i]
steps} = forall a. (a -> Bool) -> [a] -> [a]
filter (forall {a}. Ord a => a -> Interval a -> Bool
atSameTime a
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t i. Step t i -> Interval t
pInterval) [Step a i]
steps
    where
        atSameTime :: a -> Interval a -> Bool
atSameTime a
a Interval a
ti = a
a forall {a}. Ord a => a -> Interval a -> Bool
`member` Interval a
ti

extractInstructionAt :: u -> t -> [Instruction u]
extractInstructionAt u
pu t
t = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall pu t v x.
Typeable (Instruction pu) =>
pu -> Step t (StepInfo v x t) -> Maybe (Instruction pu)
inst u
pu) forall a b. (a -> b) -> a -> b
$ forall {a} {i}. Ord a => a -> Process a i -> [Step a i]
whatsHappen t
t forall a b. (a -> b) -> a -> b
$ forall u v x t.
ProcessorUnit u v x t =>
u -> Process t (StepInfo v x t)
process u
pu
    where
        inst :: Typeable (Instruction pu) => pu -> Step t (StepInfo v x t) -> Maybe (Instruction pu)
        inst :: forall pu t v x.
Typeable (Instruction pu) =>
pu -> Step t (StepInfo v x t) -> Maybe (Instruction pu)
inst pu
_ Step{pDesc :: forall t i. Step t i -> i
pDesc = InstructionStep Instruction pu
instr} = forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast Instruction pu
instr
        inst pu
_ Step t (StepInfo v x t)
_ = forall a. Maybe a
Nothing

{- | Shift @nextTick@ value if it is not zero on a specific offset. Use case: The
processor unit has buffered output, so we should provide @oe@ signal for one
tick before data actually send to the bus. That raises the following cases:

1. First usage. We can receive value immediately on nextTick

    @
    tick | Endpoint     | Instruction |
     0   | Target "c"   | WR          | <- nextTick
    @

2. Not first usage. We need to wait for one tick from the last instruction due to the offset between instruction and data transfers.

    @
    tick | Endpoint     | Instruction |
      8  |              | OE          |
      9  | Source ["b"] |             | <- nextTick
     10  | Target "c"   | WR          |
    @
-}
a
0 withShift :: a -> a -> a
`withShift` a
_offset = a
0
a
tick `withShift` a
offset = a
tick forall a. Num a => a -> a -> a
+ a
offset

---------------------------------------------------------------------

{- | Type class for controllable units. Defines two level of a unit behaviour
representation (see ahead).
-}
class Controllable pu where
    -- Instruction describe unit behaviour on each mUnit cycle. If instruction
    -- not defined for some cycles - it should be interpreted as NOP.
    data Instruction pu :: Type

    -- | Microcode desctibe controll signals on each mUnit cycle (without exclusion).
    data Microcode pu :: Type

    -- | Zip port signal tags and value.
    zipSignalTagsAndValues :: Ports pu -> Microcode pu -> [(SignalTag, SignalValue)]

    -- | Get list of used control signal tags.
    usedPortTags :: Ports pu -> [SignalTag]

    -- | Take signal tags from inifinite list of tags.
    takePortTags :: [SignalTag] -> pu -> Ports pu

-- | Getting microcode value at a specific time.
class ByTime pu t | pu -> t where
    microcodeAt :: pu -> t -> Microcode pu

instance
    ( Show (Instruction pu)
    , Default (Microcode pu)
    , ProcessorUnit pu v x t
    , UnambiguouslyDecode pu
    , Typeable pu
    ) =>
    ByTime pu t
    where
    microcodeAt :: pu -> t -> Microcode pu
microcodeAt pu
pu t
t = case forall {u} {v} {x} {t}.
(ProcessorUnit u v x t, Typeable u) =>
u -> t -> [Instruction u]
extractInstructionAt pu
pu t
t of
        [] -> forall a. Default a => a
def
        [Instruction pu
instr] -> forall pu. UnambiguouslyDecode pu => Instruction pu -> Microcode pu
decodeInstruction Instruction pu
instr
        [Instruction pu]
is -> forall a. HasCallStack => String -> a
error [i|instruction collision at #{ t } tick: #{ is } #{ pretty $ process pu }|]

newtype SignalTag = SignalTag {SignalTag -> Text
signalTag :: T.Text} deriving (SignalTag -> SignalTag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignalTag -> SignalTag -> Bool
$c/= :: SignalTag -> SignalTag -> Bool
== :: SignalTag -> SignalTag -> Bool
$c== :: SignalTag -> SignalTag -> Bool
Eq, Eq SignalTag
SignalTag -> SignalTag -> Bool
SignalTag -> SignalTag -> Ordering
SignalTag -> SignalTag -> SignalTag
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SignalTag -> SignalTag -> SignalTag
$cmin :: SignalTag -> SignalTag -> SignalTag
max :: SignalTag -> SignalTag -> SignalTag
$cmax :: SignalTag -> SignalTag -> SignalTag
>= :: SignalTag -> SignalTag -> Bool
$c>= :: SignalTag -> SignalTag -> Bool
> :: SignalTag -> SignalTag -> Bool
$c> :: SignalTag -> SignalTag -> Bool
<= :: SignalTag -> SignalTag -> Bool
$c<= :: SignalTag -> SignalTag -> Bool
< :: SignalTag -> SignalTag -> Bool
$c< :: SignalTag -> SignalTag -> Bool
compare :: SignalTag -> SignalTag -> Ordering
$ccompare :: SignalTag -> SignalTag -> Ordering
Ord)

instance Show SignalTag where
    show :: SignalTag -> String
show = forall a. ToString a => a -> String
toString forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignalTag -> Text
signalTag

-- | Type class of processor units with control ports.
class Connected pu where
    -- | A processor unit control ports (signals, flags).
    data Ports pu :: Type

{- | Decoding microcode from a simple instruction (microcode don't change over
time).

TODO: Generalize that class for all process units, including networks.
-}
class UnambiguouslyDecode pu where
    decodeInstruction :: Instruction pu -> Microcode pu

-- | Control line value.
data SignalValue
    = -- | undefined by design (`x`)
      Undef
    | -- | boolean (`0` or `1`)
      Bool Bool
    | -- | broken value (`x`) by data colision
      BrokenSignal
    deriving (SignalValue -> SignalValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignalValue -> SignalValue -> Bool
$c/= :: SignalValue -> SignalValue -> Bool
== :: SignalValue -> SignalValue -> Bool
$c== :: SignalValue -> SignalValue -> Bool
Eq)

instance Default SignalValue where
    def :: SignalValue
def = SignalValue
Undef

instance Show SignalValue where
    show :: SignalValue -> String
show SignalValue
Undef = String
"x"
    show (Bool Bool
True) = String
"1"
    show (Bool Bool
False) = String
"0"
    show SignalValue
BrokenSignal = String
"B"

SignalValue
Undef +++ :: SignalValue -> SignalValue -> SignalValue
+++ SignalValue
v = SignalValue
v
SignalValue
v +++ SignalValue
Undef = SignalValue
v
SignalValue
_ +++ SignalValue
_ = SignalValue
BrokenSignal

------------------------------------------------------------

-- | Type class of processor units with IO ports.
class IOConnected pu where
    data IOPorts pu :: Type

    -- | External input ports, which go outside of NITTA mUnit.
    inputPorts :: IOPorts pu -> S.Set InputPortTag
    inputPorts IOPorts pu
_ = forall a. Set a
S.empty

    -- | External output ports, which go outside of NITTA mUnit.
    outputPorts :: IOPorts pu -> S.Set OutputPortTag
    outputPorts IOPorts pu
_ = forall a. Set a
S.empty

    -- | External output ports, which go outside of NITTA mUnit.
    inoutPorts :: IOPorts pu -> S.Set InoutPortTag
    inoutPorts IOPorts pu
_ = forall a. Set a
S.empty

newtype InputPortTag = InputPortTag {InputPortTag -> Text
inputPortTag :: T.Text} deriving (InputPortTag -> InputPortTag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InputPortTag -> InputPortTag -> Bool
$c/= :: InputPortTag -> InputPortTag -> Bool
== :: InputPortTag -> InputPortTag -> Bool
$c== :: InputPortTag -> InputPortTag -> Bool
Eq, Eq InputPortTag
InputPortTag -> InputPortTag -> Bool
InputPortTag -> InputPortTag -> Ordering
InputPortTag -> InputPortTag -> InputPortTag
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: InputPortTag -> InputPortTag -> InputPortTag
$cmin :: InputPortTag -> InputPortTag -> InputPortTag
max :: InputPortTag -> InputPortTag -> InputPortTag
$cmax :: InputPortTag -> InputPortTag -> InputPortTag
>= :: InputPortTag -> InputPortTag -> Bool
$c>= :: InputPortTag -> InputPortTag -> Bool
> :: InputPortTag -> InputPortTag -> Bool
$c> :: InputPortTag -> InputPortTag -> Bool
<= :: InputPortTag -> InputPortTag -> Bool
$c<= :: InputPortTag -> InputPortTag -> Bool
< :: InputPortTag -> InputPortTag -> Bool
$c< :: InputPortTag -> InputPortTag -> Bool
compare :: InputPortTag -> InputPortTag -> Ordering
$ccompare :: InputPortTag -> InputPortTag -> Ordering
Ord)
instance Show InputPortTag where show :: InputPortTag -> String
show = forall a. ToString a => a -> String
toString forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputPortTag -> Text
inputPortTag

newtype OutputPortTag = OutputPortTag {OutputPortTag -> Text
outputPortTag :: T.Text} deriving (OutputPortTag -> OutputPortTag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OutputPortTag -> OutputPortTag -> Bool
$c/= :: OutputPortTag -> OutputPortTag -> Bool
== :: OutputPortTag -> OutputPortTag -> Bool
$c== :: OutputPortTag -> OutputPortTag -> Bool
Eq, Eq OutputPortTag
OutputPortTag -> OutputPortTag -> Bool
OutputPortTag -> OutputPortTag -> Ordering
OutputPortTag -> OutputPortTag -> OutputPortTag
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OutputPortTag -> OutputPortTag -> OutputPortTag
$cmin :: OutputPortTag -> OutputPortTag -> OutputPortTag
max :: OutputPortTag -> OutputPortTag -> OutputPortTag
$cmax :: OutputPortTag -> OutputPortTag -> OutputPortTag
>= :: OutputPortTag -> OutputPortTag -> Bool
$c>= :: OutputPortTag -> OutputPortTag -> Bool
> :: OutputPortTag -> OutputPortTag -> Bool
$c> :: OutputPortTag -> OutputPortTag -> Bool
<= :: OutputPortTag -> OutputPortTag -> Bool
$c<= :: OutputPortTag -> OutputPortTag -> Bool
< :: OutputPortTag -> OutputPortTag -> Bool
$c< :: OutputPortTag -> OutputPortTag -> Bool
compare :: OutputPortTag -> OutputPortTag -> Ordering
$ccompare :: OutputPortTag -> OutputPortTag -> Ordering
Ord)
instance Show OutputPortTag where show :: OutputPortTag -> String
show = forall a. ToString a => a -> String
toString forall b c a. (b -> c) -> (a -> b) -> a -> c
. OutputPortTag -> Text
outputPortTag

newtype InoutPortTag = InoutPortTag {InoutPortTag -> Text
inoutPortTag :: T.Text} deriving (InoutPortTag -> InoutPortTag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InoutPortTag -> InoutPortTag -> Bool
$c/= :: InoutPortTag -> InoutPortTag -> Bool
== :: InoutPortTag -> InoutPortTag -> Bool
$c== :: InoutPortTag -> InoutPortTag -> Bool
Eq, Eq InoutPortTag
InoutPortTag -> InoutPortTag -> Bool
InoutPortTag -> InoutPortTag -> Ordering
InoutPortTag -> InoutPortTag -> InoutPortTag
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: InoutPortTag -> InoutPortTag -> InoutPortTag
$cmin :: InoutPortTag -> InoutPortTag -> InoutPortTag
max :: InoutPortTag -> InoutPortTag -> InoutPortTag
$cmax :: InoutPortTag -> InoutPortTag -> InoutPortTag
>= :: InoutPortTag -> InoutPortTag -> Bool
$c>= :: InoutPortTag -> InoutPortTag -> Bool
> :: InoutPortTag -> InoutPortTag -> Bool
$c> :: InoutPortTag -> InoutPortTag -> Bool
<= :: InoutPortTag -> InoutPortTag -> Bool
$c<= :: InoutPortTag -> InoutPortTag -> Bool
< :: InoutPortTag -> InoutPortTag -> Bool
$c< :: InoutPortTag -> InoutPortTag -> Bool
compare :: InoutPortTag -> InoutPortTag -> Ordering
$ccompare :: InoutPortTag -> InoutPortTag -> Ordering
Ord)
instance Show InoutPortTag where show :: InoutPortTag -> String
show = forall a. ToString a => a -> String
toString forall b c a. (b -> c) -> (a -> b) -> a -> c
. InoutPortTag -> Text
inoutPortTag