{-# LANGUAGE RecordWildCards, LambdaCase #-} module RetroClash.SerialTx ( serialTx , serialTxDyn , fifo , TxState(..) , TxBit(..) , txStep ) where import Clash.Prelude import RetroClash.Utils import RetroClash.Clock import Control.Monad.State import Control.Monad.Writer import Data.Foldable (traverse_) import Data.Word data TxState n = TxIdle | TxBit Word32 (TxBit n) deriving (Int -> TxState n -> ShowS [TxState n] -> ShowS TxState n -> String (Int -> TxState n -> ShowS) -> (TxState n -> String) -> ([TxState n] -> ShowS) -> Show (TxState n) forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a forall (n :: Nat). KnownNat n => Int -> TxState n -> ShowS forall (n :: Nat). KnownNat n => [TxState n] -> ShowS forall (n :: Nat). KnownNat n => TxState n -> String showList :: [TxState n] -> ShowS $cshowList :: forall (n :: Nat). KnownNat n => [TxState n] -> ShowS show :: TxState n -> String $cshow :: forall (n :: Nat). KnownNat n => TxState n -> String showsPrec :: Int -> TxState n -> ShowS $cshowsPrec :: forall (n :: Nat). KnownNat n => Int -> TxState n -> ShowS Show, TxState n -> TxState n -> Bool (TxState n -> TxState n -> Bool) -> (TxState n -> TxState n -> Bool) -> Eq (TxState n) forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a forall (n :: Nat). KnownNat n => TxState n -> TxState n -> Bool /= :: TxState n -> TxState n -> Bool $c/= :: forall (n :: Nat). KnownNat n => TxState n -> TxState n -> Bool == :: TxState n -> TxState n -> Bool $c== :: forall (n :: Nat). KnownNat n => TxState n -> TxState n -> Bool Eq, (forall x. TxState n -> Rep (TxState n) x) -> (forall x. Rep (TxState n) x -> TxState n) -> Generic (TxState n) forall x. Rep (TxState n) x -> TxState n forall x. TxState n -> Rep (TxState n) x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a forall (n :: Nat) x. Rep (TxState n) x -> TxState n forall (n :: Nat) x. TxState n -> Rep (TxState n) x $cto :: forall (n :: Nat) x. Rep (TxState n) x -> TxState n $cfrom :: forall (n :: Nat) x. TxState n -> Rep (TxState n) x Generic, HasCallStack => String -> TxState n TxState n -> Bool TxState n -> () TxState n -> TxState n (HasCallStack => String -> TxState n) -> (TxState n -> Bool) -> (TxState n -> TxState n) -> (TxState n -> ()) -> NFDataX (TxState n) forall a. (HasCallStack => String -> a) -> (a -> Bool) -> (a -> a) -> (a -> ()) -> NFDataX a forall (n :: Nat). (KnownNat n, HasCallStack) => String -> TxState n forall (n :: Nat). KnownNat n => TxState n -> Bool forall (n :: Nat). KnownNat n => TxState n -> () forall (n :: Nat). KnownNat n => TxState n -> TxState n rnfX :: TxState n -> () $crnfX :: forall (n :: Nat). KnownNat n => TxState n -> () ensureSpine :: TxState n -> TxState n $censureSpine :: forall (n :: Nat). KnownNat n => TxState n -> TxState n hasUndefined :: TxState n -> Bool $chasUndefined :: forall (n :: Nat). KnownNat n => TxState n -> Bool deepErrorX :: String -> TxState n $cdeepErrorX :: forall (n :: Nat). (KnownNat n, HasCallStack) => String -> TxState n NFDataX) data TxBit n = StartBit (BitVector n) | DataBit (BitVector n) (Index n) | StopBit deriving (Int -> TxBit n -> ShowS [TxBit n] -> ShowS TxBit n -> String (Int -> TxBit n -> ShowS) -> (TxBit n -> String) -> ([TxBit n] -> ShowS) -> Show (TxBit n) forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a forall (n :: Nat). KnownNat n => Int -> TxBit n -> ShowS forall (n :: Nat). KnownNat n => [TxBit n] -> ShowS forall (n :: Nat). KnownNat n => TxBit n -> String showList :: [TxBit n] -> ShowS $cshowList :: forall (n :: Nat). KnownNat n => [TxBit n] -> ShowS show :: TxBit n -> String $cshow :: forall (n :: Nat). KnownNat n => TxBit n -> String showsPrec :: Int -> TxBit n -> ShowS $cshowsPrec :: forall (n :: Nat). KnownNat n => Int -> TxBit n -> ShowS Show, TxBit n -> TxBit n -> Bool (TxBit n -> TxBit n -> Bool) -> (TxBit n -> TxBit n -> Bool) -> Eq (TxBit n) forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a forall (n :: Nat). KnownNat n => TxBit n -> TxBit n -> Bool /= :: TxBit n -> TxBit n -> Bool $c/= :: forall (n :: Nat). KnownNat n => TxBit n -> TxBit n -> Bool == :: TxBit n -> TxBit n -> Bool $c== :: forall (n :: Nat). KnownNat n => TxBit n -> TxBit n -> Bool Eq, (forall x. TxBit n -> Rep (TxBit n) x) -> (forall x. Rep (TxBit n) x -> TxBit n) -> Generic (TxBit n) forall x. Rep (TxBit n) x -> TxBit n forall x. TxBit n -> Rep (TxBit n) x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a forall (n :: Nat) x. Rep (TxBit n) x -> TxBit n forall (n :: Nat) x. TxBit n -> Rep (TxBit n) x $cto :: forall (n :: Nat) x. Rep (TxBit n) x -> TxBit n $cfrom :: forall (n :: Nat) x. TxBit n -> Rep (TxBit n) x Generic, HasCallStack => String -> TxBit n TxBit n -> Bool TxBit n -> () TxBit n -> TxBit n (HasCallStack => String -> TxBit n) -> (TxBit n -> Bool) -> (TxBit n -> TxBit n) -> (TxBit n -> ()) -> NFDataX (TxBit n) forall a. (HasCallStack => String -> a) -> (a -> Bool) -> (a -> a) -> (a -> ()) -> NFDataX a forall (n :: Nat). (KnownNat n, HasCallStack) => String -> TxBit n forall (n :: Nat). KnownNat n => TxBit n -> Bool forall (n :: Nat). KnownNat n => TxBit n -> () forall (n :: Nat). KnownNat n => TxBit n -> TxBit n rnfX :: TxBit n -> () $crnfX :: forall (n :: Nat). KnownNat n => TxBit n -> () ensureSpine :: TxBit n -> TxBit n $censureSpine :: forall (n :: Nat). KnownNat n => TxBit n -> TxBit n hasUndefined :: TxBit n -> Bool $chasUndefined :: forall (n :: Nat). KnownNat n => TxBit n -> Bool deepErrorX :: String -> TxBit n $cdeepErrorX :: forall (n :: Nat). (KnownNat n, HasCallStack) => String -> TxBit n NFDataX) txStep :: forall n. (KnownNat n) => Word32 -> Maybe (BitVector n) -> State (TxState n) (Bit, Bool) txStep :: Word32 -> Maybe (BitVector n) -> State (TxState n) (Bit, Bool) txStep Word32 bitDuration Maybe (BitVector n) input = ((Bit, Any) -> (Bit, Bool)) -> StateT (TxState n) Identity (Bit, Any) -> State (TxState n) (Bit, Bool) forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b fmap ((Any -> Bool) -> (Bit, Any) -> (Bit, Bool) forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b fmap Any -> Bool getAny) (StateT (TxState n) Identity (Bit, Any) -> State (TxState n) (Bit, Bool)) -> (WriterT Any (StateT (TxState n) Identity) Bit -> StateT (TxState n) Identity (Bit, Any)) -> WriterT Any (StateT (TxState n) Identity) Bit -> State (TxState n) (Bit, Bool) forall b c a. (b -> c) -> (a -> b) -> a -> c . WriterT Any (StateT (TxState n) Identity) Bit -> StateT (TxState n) Identity (Bit, Any) forall w (m :: Type -> Type) a. WriterT w m a -> m (a, w) runWriterT (WriterT Any (StateT (TxState n) Identity) Bit -> State (TxState n) (Bit, Bool)) -> WriterT Any (StateT (TxState n) Identity) Bit -> State (TxState n) (Bit, Bool) forall a b. (a -> b) -> a -> b $ WriterT Any (StateT (TxState n) Identity) (TxState n) forall s (m :: Type -> Type). MonadState s m => m s get WriterT Any (StateT (TxState n) Identity) (TxState n) -> (TxState n -> WriterT Any (StateT (TxState n) Identity) Bit) -> WriterT Any (StateT (TxState n) Identity) Bit forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b >>= \case TxState n TxIdle -> do Any -> WriterT Any (StateT (TxState n) Identity) () forall w (m :: Type -> Type). MonadWriter w m => w -> m () tell (Any -> WriterT Any (StateT (TxState n) Identity) ()) -> Any -> WriterT Any (StateT (TxState n) Identity) () forall a b. (a -> b) -> a -> b $ Bool -> Any Any Bool True (BitVector n -> WriterT Any (StateT (TxState n) Identity) ()) -> Maybe (BitVector n) -> WriterT Any (StateT (TxState n) Identity) () forall (t :: Type -> Type) (f :: Type -> Type) a b. (Foldable t, Applicative f) => (a -> f b) -> t a -> f () traverse_ (TxBit n -> WriterT Any (StateT (TxState n) Identity) () goto (TxBit n -> WriterT Any (StateT (TxState n) Identity) ()) -> (BitVector n -> TxBit n) -> BitVector n -> WriterT Any (StateT (TxState n) Identity) () forall b c a. (b -> c) -> (a -> b) -> a -> c . BitVector n -> TxBit n forall (n :: Nat). BitVector n -> TxBit n StartBit) Maybe (BitVector n) input Bit -> WriterT Any (StateT (TxState n) Identity) Bit forall (m :: Type -> Type) a. Monad m => a -> m a return Bit high TxBit Word32 cnt TxBit n tx -> Word32 -> TxBit n -> WriterT Any (StateT (TxState n) Identity) Bit -> WriterT Any (StateT (TxState n) Identity) Bit forall (f :: Type -> Type) (n :: Nat) a. MonadState (TxState n) f => Word32 -> TxBit n -> f a -> f a slowly Word32 cnt TxBit n tx (WriterT Any (StateT (TxState n) Identity) Bit -> WriterT Any (StateT (TxState n) Identity) Bit) -> WriterT Any (StateT (TxState n) Identity) Bit -> WriterT Any (StateT (TxState n) Identity) Bit forall a b. (a -> b) -> a -> b $ case TxBit n tx of StartBit BitVector n xs -> do TxBit n -> WriterT Any (StateT (TxState n) Identity) () goto (TxBit n -> WriterT Any (StateT (TxState n) Identity) ()) -> TxBit n -> WriterT Any (StateT (TxState n) Identity) () forall a b. (a -> b) -> a -> b $ BitVector n -> Index n -> TxBit n forall (n :: Nat). BitVector n -> Index n -> TxBit n DataBit BitVector n xs Index n 0 Bit -> WriterT Any (StateT (TxState n) Identity) Bit forall (m :: Type -> Type) a. Monad m => a -> m a return Bit low DataBit BitVector n xs Index n i -> do let (BitVector n xs', Bit _) = Bit -> BitVector n -> (BitVector n, Bit) forall (n :: Nat). KnownNat n => Bit -> BitVector n -> (BitVector n, Bit) bvShiftR Bit 0 BitVector n xs TxBit n -> WriterT Any (StateT (TxState n) Identity) () goto (TxBit n -> WriterT Any (StateT (TxState n) Identity) ()) -> TxBit n -> WriterT Any (StateT (TxState n) Identity) () forall a b. (a -> b) -> a -> b $ TxBit n -> (Index n -> TxBit n) -> Maybe (Index n) -> TxBit n forall b a. b -> (a -> b) -> Maybe a -> b maybe TxBit n forall (n :: Nat). TxBit n StopBit (BitVector n -> Index n -> TxBit n forall (n :: Nat). BitVector n -> Index n -> TxBit n DataBit BitVector n xs') (Maybe (Index n) -> TxBit n) -> Maybe (Index n) -> TxBit n forall a b. (a -> b) -> a -> b $ Index n -> Maybe (Index n) forall a. (Eq a, Enum a, Bounded a) => a -> Maybe a succIdx Index n i Bit -> WriterT Any (StateT (TxState n) Identity) Bit forall (m :: Type -> Type) a. Monad m => a -> m a return (Bit -> WriterT Any (StateT (TxState n) Identity) Bit) -> Bit -> WriterT Any (StateT (TxState n) Identity) Bit forall a b. (a -> b) -> a -> b $ BitVector n -> Bit forall a. BitPack a => a -> Bit lsb BitVector n xs TxBit n StopBit -> do TxState n -> WriterT Any (StateT (TxState n) Identity) () forall s (m :: Type -> Type). MonadState s m => s -> m () put TxState n forall (n :: Nat). TxState n TxIdle Bit -> WriterT Any (StateT (TxState n) Identity) Bit forall (m :: Type -> Type) a. Monad m => a -> m a return Bit high where goto :: TxBit n -> WriterT Any (StateT (TxState n) Identity) () goto = TxState n -> WriterT Any (StateT (TxState n) Identity) () forall s (m :: Type -> Type). MonadState s m => s -> m () put (TxState n -> WriterT Any (StateT (TxState n) Identity) ()) -> (TxBit n -> TxState n) -> TxBit n -> WriterT Any (StateT (TxState n) Identity) () forall b c a. (b -> c) -> (a -> b) -> a -> c . Word32 -> TxBit n -> TxState n forall (n :: Nat). Word32 -> TxBit n -> TxState n TxBit Word32 bitDuration slowly :: Word32 -> TxBit n -> f a -> f a slowly Word32 cnt TxBit n tx f a act | Word32 cnt Word32 -> Word32 -> Bool forall a. Ord a => a -> a -> Bool > Word32 1 = f a act f a -> f () -> f a forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a <* TxState n -> f () forall s (m :: Type -> Type). MonadState s m => s -> m () put (Word32 -> TxBit n -> TxState n forall (n :: Nat). Word32 -> TxBit n -> TxState n TxBit (Word32 cnt Word32 -> Word32 -> Word32 forall a. Num a => a -> a -> a - Word32 1) TxBit n tx) | Bool otherwise = f a act serialTxDyn :: (KnownNat n, HiddenClockResetEnable dom) => Signal dom Word32 -> Signal dom (Maybe (BitVector n)) -> (Signal dom Bit, Signal dom Bool) serialTxDyn :: Signal dom Word32 -> Signal dom (Maybe (BitVector n)) -> (Signal dom Bit, Signal dom Bool) serialTxDyn Signal dom Word32 bitDuration Signal dom (Maybe (BitVector n)) input = ((Word32, Maybe (BitVector n)) -> State (TxState n) (Bit, Bool)) -> TxState n -> Unbundled dom (Word32, Maybe (BitVector n)) -> Unbundled dom (Bit, Bool) forall (dom :: Domain) s i o. (HiddenClockResetEnable dom, NFDataX s, Bundle i, Bundle o) => (i -> State s o) -> s -> Unbundled dom i -> Unbundled dom o mealyStateB ((Word32 -> Maybe (BitVector n) -> State (TxState n) (Bit, Bool)) -> (Word32, Maybe (BitVector n)) -> State (TxState n) (Bit, Bool) forall a b c. (a -> b -> c) -> (a, b) -> c uncurry Word32 -> Maybe (BitVector n) -> State (TxState n) (Bit, Bool) forall (n :: Nat). KnownNat n => Word32 -> Maybe (BitVector n) -> State (TxState n) (Bit, Bool) txStep) TxState n forall (n :: Nat). TxState n TxIdle (Signal dom Word32 bitDuration, Signal dom (Maybe (BitVector n)) input) serialTx :: forall n rate dom. (KnownNat n, KnownNat (ClockDivider dom (HzToPeriod rate)), HiddenClockResetEnable dom) => SNat rate -> Signal dom (Maybe (BitVector n)) -> (Signal dom Bit, Signal dom Bool) serialTx :: SNat rate -> Signal dom (Maybe (BitVector n)) -> (Signal dom Bit, Signal dom Bool) serialTx SNat rate rate = Signal dom Word32 -> Signal dom (Maybe (BitVector n)) -> (Signal dom Bit, Signal dom Bool) forall (n :: Nat) (dom :: Domain). (KnownNat n, HiddenClockResetEnable dom) => Signal dom Word32 -> Signal dom (Maybe (BitVector n)) -> (Signal dom Bit, Signal dom Bool) serialTxDyn (Signal dom Word32 -> Signal dom (Maybe (BitVector n)) -> (Signal dom Bit, Signal dom Bool)) -> Signal dom Word32 -> Signal dom (Maybe (BitVector n)) -> (Signal dom Bit, Signal dom Bool) forall a b. (a -> b) -> a -> b $ Word32 -> Signal dom Word32 forall (f :: Type -> Type) a. Applicative f => a -> f a pure (Word32 -> Signal dom Word32) -> (SNat (Div (Div (Picoseconds 1000000000000) rate) (DomainConfigurationPeriod (KnownConf dom))) -> Word32) -> SNat (Div (Div (Picoseconds 1000000000000) rate) (DomainConfigurationPeriod (KnownConf dom))) -> Signal dom Word32 forall b c a. (b -> c) -> (a -> b) -> a -> c . Integer -> Word32 forall a b. (Integral a, Num b) => a -> b fromIntegral (Integer -> Word32) -> (SNat (Div (Div (Picoseconds 1000000000000) rate) (DomainConfigurationPeriod (KnownConf dom))) -> Integer) -> SNat (Div (Div (Picoseconds 1000000000000) rate) (DomainConfigurationPeriod (KnownConf dom))) -> Word32 forall b c a. (b -> c) -> (a -> b) -> a -> c . SNat (Div (Div (Picoseconds 1000000000000) rate) (DomainConfigurationPeriod (KnownConf dom))) -> Integer forall (n :: Nat) (proxy :: Nat -> Type). KnownNat n => proxy n -> Integer natVal (SNat (Div (Div (Picoseconds 1000000000000) rate) (DomainConfigurationPeriod (KnownConf dom))) -> Signal dom Word32) -> SNat (Div (Div (Picoseconds 1000000000000) rate) (DomainConfigurationPeriod (KnownConf dom))) -> Signal dom Word32 forall a b. (a -> b) -> a -> b $ KnownNat (ClockDivider dom (HzToPeriod rate)) => SNat (ClockDivider dom (HzToPeriod rate)) forall (n :: Nat). KnownNat n => SNat n SNat @(ClockDivider dom (HzToPeriod rate)) fifo :: forall a dom. (NFDataX a, HiddenClockResetEnable dom) => Signal dom (Maybe a) -> Signal dom Bool -> Signal dom (Maybe a) fifo :: Signal dom (Maybe a) -> Signal dom Bool -> Signal dom (Maybe a) fifo Signal dom (Maybe a) input Signal dom Bool outReady = Signal dom (Maybe a) r where r :: Signal dom (Maybe a) r = Maybe a -> Signal dom (Maybe a) -> Signal dom (Maybe a) forall (dom :: Domain) a. (HiddenClockResetEnable dom, NFDataX a) => a -> Signal dom a -> Signal dom a register Maybe a forall a. Maybe a Nothing (Signal dom (Maybe a) -> Signal dom (Maybe a)) -> Signal dom (Maybe a) -> Signal dom (Maybe a) forall a b. (a -> b) -> a -> b $ Signal dom Bool -> Signal dom (Maybe a) -> Signal dom (Maybe a) -> Signal dom (Maybe a) forall (f :: Type -> Type) a. Applicative f => f Bool -> f a -> f a -> f a mux Signal dom Bool outReady Signal dom (Maybe a) input (Maybe a -> Maybe a -> Maybe a forall (m :: Type -> Type) a. MonadPlus m => m a -> m a -> m a mplus (Maybe a -> Maybe a -> Maybe a) -> Signal dom (Maybe a) -> Signal dom (Maybe a -> Maybe a) forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b <$> Signal dom (Maybe a) r Signal dom (Maybe a -> Maybe a) -> Signal dom (Maybe a) -> Signal dom (Maybe a) forall (f :: Type -> Type) a b. Applicative f => f (a -> b) -> f a -> f b <*> Signal dom (Maybe a) input)