{-# LANGUAGE RecordWildCards, LambdaCase #-} module RetroClash.SerialRx ( serialRx , serialRxDyn , RxState(..) , RxBit(..) , rxStep ) where import Clash.Prelude import RetroClash.Utils import RetroClash.Clock import Control.Monad (when) import Control.Monad.State import Control.Monad.Trans.Writer import Data.Monoid import Data.Word data RxState n = RxIdle | RxBit Word32 (Maybe Bit) (RxBit n) deriving ((forall x. RxState n -> Rep (RxState n) x) -> (forall x. Rep (RxState n) x -> RxState n) -> Generic (RxState n) forall (n :: Nat) x. Rep (RxState n) x -> RxState n forall (n :: Nat) x. RxState n -> Rep (RxState n) x forall x. Rep (RxState n) x -> RxState n forall x. RxState n -> Rep (RxState n) x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cfrom :: forall (n :: Nat) x. RxState n -> Rep (RxState n) x from :: forall x. RxState n -> Rep (RxState n) x $cto :: forall (n :: Nat) x. Rep (RxState n) x -> RxState n to :: forall x. Rep (RxState n) x -> RxState n Generic, RxState n -> RxState n -> Bool (RxState n -> RxState n -> Bool) -> (RxState n -> RxState n -> Bool) -> Eq (RxState n) forall (n :: Nat). KnownNat n => RxState n -> RxState n -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: forall (n :: Nat). KnownNat n => RxState n -> RxState n -> Bool == :: RxState n -> RxState n -> Bool $c/= :: forall (n :: Nat). KnownNat n => RxState n -> RxState n -> Bool /= :: RxState n -> RxState n -> Bool Eq, Int -> RxState n -> ShowS [RxState n] -> ShowS RxState n -> String (Int -> RxState n -> ShowS) -> (RxState n -> String) -> ([RxState n] -> ShowS) -> Show (RxState n) forall (n :: Nat). KnownNat n => Int -> RxState n -> ShowS forall (n :: Nat). KnownNat n => [RxState n] -> ShowS forall (n :: Nat). KnownNat n => RxState n -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: forall (n :: Nat). KnownNat n => Int -> RxState n -> ShowS showsPrec :: Int -> RxState n -> ShowS $cshow :: forall (n :: Nat). KnownNat n => RxState n -> String show :: RxState n -> String $cshowList :: forall (n :: Nat). KnownNat n => [RxState n] -> ShowS showList :: [RxState n] -> ShowS Show, HasCallStack => String -> RxState n RxState n -> Bool RxState n -> () RxState n -> RxState n (HasCallStack => String -> RxState n) -> (RxState n -> Bool) -> (RxState n -> RxState n) -> (RxState n -> ()) -> NFDataX (RxState n) forall (n :: Nat). (KnownNat n, HasCallStack) => String -> RxState n forall (n :: Nat). KnownNat n => RxState n -> Bool forall (n :: Nat). KnownNat n => RxState n -> () forall (n :: Nat). KnownNat n => RxState n -> RxState n forall a. (HasCallStack => String -> a) -> (a -> Bool) -> (a -> a) -> (a -> ()) -> NFDataX a $cdeepErrorX :: forall (n :: Nat). (KnownNat n, HasCallStack) => String -> RxState n deepErrorX :: HasCallStack => String -> RxState n $chasUndefined :: forall (n :: Nat). KnownNat n => RxState n -> Bool hasUndefined :: RxState n -> Bool $censureSpine :: forall (n :: Nat). KnownNat n => RxState n -> RxState n ensureSpine :: RxState n -> RxState n $crnfX :: forall (n :: Nat). KnownNat n => RxState n -> () rnfX :: RxState n -> () NFDataX) data RxBit n = StartBit | DataBit (BitVector n) (Index n) | StopBit (BitVector n) deriving ((forall x. RxBit n -> Rep (RxBit n) x) -> (forall x. Rep (RxBit n) x -> RxBit n) -> Generic (RxBit n) forall (n :: Nat) x. Rep (RxBit n) x -> RxBit n forall (n :: Nat) x. RxBit n -> Rep (RxBit n) x forall x. Rep (RxBit n) x -> RxBit n forall x. RxBit n -> Rep (RxBit n) x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cfrom :: forall (n :: Nat) x. RxBit n -> Rep (RxBit n) x from :: forall x. RxBit n -> Rep (RxBit n) x $cto :: forall (n :: Nat) x. Rep (RxBit n) x -> RxBit n to :: forall x. Rep (RxBit n) x -> RxBit n Generic, RxBit n -> RxBit n -> Bool (RxBit n -> RxBit n -> Bool) -> (RxBit n -> RxBit n -> Bool) -> Eq (RxBit n) forall (n :: Nat). KnownNat n => RxBit n -> RxBit n -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: forall (n :: Nat). KnownNat n => RxBit n -> RxBit n -> Bool == :: RxBit n -> RxBit n -> Bool $c/= :: forall (n :: Nat). KnownNat n => RxBit n -> RxBit n -> Bool /= :: RxBit n -> RxBit n -> Bool Eq, Int -> RxBit n -> ShowS [RxBit n] -> ShowS RxBit n -> String (Int -> RxBit n -> ShowS) -> (RxBit n -> String) -> ([RxBit n] -> ShowS) -> Show (RxBit n) forall (n :: Nat). KnownNat n => Int -> RxBit n -> ShowS forall (n :: Nat). KnownNat n => [RxBit n] -> ShowS forall (n :: Nat). KnownNat n => RxBit n -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: forall (n :: Nat). KnownNat n => Int -> RxBit n -> ShowS showsPrec :: Int -> RxBit n -> ShowS $cshow :: forall (n :: Nat). KnownNat n => RxBit n -> String show :: RxBit n -> String $cshowList :: forall (n :: Nat). KnownNat n => [RxBit n] -> ShowS showList :: [RxBit n] -> ShowS Show, HasCallStack => String -> RxBit n RxBit n -> Bool RxBit n -> () RxBit n -> RxBit n (HasCallStack => String -> RxBit n) -> (RxBit n -> Bool) -> (RxBit n -> RxBit n) -> (RxBit n -> ()) -> NFDataX (RxBit n) forall (n :: Nat). (KnownNat n, HasCallStack) => String -> RxBit n forall (n :: Nat). KnownNat n => RxBit n -> Bool forall (n :: Nat). KnownNat n => RxBit n -> () forall (n :: Nat). KnownNat n => RxBit n -> RxBit n forall a. (HasCallStack => String -> a) -> (a -> Bool) -> (a -> a) -> (a -> ()) -> NFDataX a $cdeepErrorX :: forall (n :: Nat). (KnownNat n, HasCallStack) => String -> RxBit n deepErrorX :: HasCallStack => String -> RxBit n $chasUndefined :: forall (n :: Nat). KnownNat n => RxBit n -> Bool hasUndefined :: RxBit n -> Bool $censureSpine :: forall (n :: Nat). KnownNat n => RxBit n -> RxBit n ensureSpine :: RxBit n -> RxBit n $crnfX :: forall (n :: Nat). KnownNat n => RxBit n -> () rnfX :: RxBit n -> () NFDataX) rxStep :: (KnownNat n) => Word32 -> Bit -> State (RxState n) (Maybe (BitVector n)) rxStep :: forall (n :: Nat). KnownNat n => Word32 -> Bit -> State (RxState n) (Maybe (BitVector n)) rxStep Word32 bitDuration Bit input = (Last (BitVector n) -> Maybe (BitVector n)) -> StateT (RxState n) Identity (Last (BitVector n)) -> StateT (RxState n) Identity (Maybe (BitVector n)) forall a b. (a -> b) -> StateT (RxState n) Identity a -> StateT (RxState n) Identity b forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b fmap Last (BitVector n) -> Maybe (BitVector n) forall a. Last a -> Maybe a getLast (StateT (RxState n) Identity (Last (BitVector n)) -> StateT (RxState n) Identity (Maybe (BitVector n))) -> (WriterT (Last (BitVector n)) (StateT (RxState n) Identity) () -> StateT (RxState n) Identity (Last (BitVector n))) -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) () -> StateT (RxState n) Identity (Maybe (BitVector n)) forall b c a. (b -> c) -> (a -> b) -> a -> c . WriterT (Last (BitVector n)) (StateT (RxState n) Identity) () -> StateT (RxState n) Identity (Last (BitVector n)) forall (m :: Type -> Type) w a. Monad m => WriterT w m a -> m w execWriterT (WriterT (Last (BitVector n)) (StateT (RxState n) Identity) () -> StateT (RxState n) Identity (Maybe (BitVector n))) -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) () -> StateT (RxState n) Identity (Maybe (BitVector n)) forall a b. (a -> b) -> a -> b $ WriterT (Last (BitVector n)) (StateT (RxState n) Identity) (RxState n) forall s (m :: Type -> Type). MonadState s m => m s get WriterT (Last (BitVector n)) (StateT (RxState n) Identity) (RxState n) -> (RxState n -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) ()) -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) () forall a b. WriterT (Last (BitVector n)) (StateT (RxState n) Identity) a -> (a -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) b) -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) b forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b >>= \case RxState n RxIdle -> do Bool -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) () -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) () forall (f :: Type -> Type). Applicative f => Bool -> f () -> f () when (Bit input Bit -> Bit -> Bool forall a. Eq a => a -> a -> Bool == Bit low) (WriterT (Last (BitVector n)) (StateT (RxState n) Identity) () -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) ()) -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) () -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) () forall a b. (a -> b) -> a -> b $ RxState n -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) () forall s (m :: Type -> Type). MonadState s m => s -> m () put (RxState n -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) ()) -> RxState n -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) () forall a b. (a -> b) -> a -> b $ Word32 -> Maybe Bit -> RxBit n -> RxState n forall (n :: Nat). Word32 -> Maybe Bit -> RxBit n -> RxState n RxBit (Word32 bitDuration1 Word32 -> Word32 -> Word32 forall a. Num a => a -> a -> a - Word32 1) Maybe Bit forall a. Maybe a Nothing RxBit n forall (n :: Nat). RxBit n StartBit RxBit Word32 cnt Maybe Bit sample RxBit n b | Word32 cnt Word32 -> Word32 -> Bool forall a. Ord a => a -> a -> Bool > Word32 1 -> do RxState n -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) () forall s (m :: Type -> Type). MonadState s m => s -> m () put (RxState n -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) ()) -> RxState n -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) () forall a b. (a -> b) -> a -> b $ Word32 -> Maybe Bit -> RxBit n -> RxState n forall (n :: Nat). Word32 -> Maybe Bit -> RxBit n -> RxState n RxBit (Word32 cnt Word32 -> Word32 -> Word32 forall a. Num a => a -> a -> a - Word32 1) Maybe Bit sample RxBit n b RxBit Word32 _ Maybe Bit Nothing RxBit n b -> do Bit -> RxBit n -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) () consume Bit input RxBit n b RxBit Word32 _ (Just Bit sample) RxBit n rx -> case RxBit n rx of RxBit n StartBit -> do if Bit sample Bit -> Bit -> Bool forall a. Eq a => a -> a -> Bool == Bit low then RxBit n -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) () waitFor (BitVector n -> Index n -> RxBit n forall (n :: Nat). BitVector n -> Index n -> RxBit n DataBit BitVector n 0 Index n 0) else RxState n -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) () forall s (m :: Type -> Type). MonadState s m => s -> m () put RxState n forall (n :: Nat). RxState n RxIdle 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 sample BitVector n xs RxBit n -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) () waitFor (RxBit n -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) ()) -> RxBit n -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) () forall a b. (a -> b) -> a -> b $ RxBit n -> (Index n -> RxBit n) -> Maybe (Index n) -> RxBit n forall b a. b -> (a -> b) -> Maybe a -> b maybe (BitVector n -> RxBit n forall (n :: Nat). BitVector n -> RxBit n StopBit BitVector n xs') (BitVector n -> Index n -> RxBit n forall (n :: Nat). BitVector n -> Index n -> RxBit n DataBit BitVector n xs') (Maybe (Index n) -> RxBit n) -> Maybe (Index n) -> RxBit 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 StopBit BitVector n xs -> do Bool -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) () -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) () forall (f :: Type -> Type). Applicative f => Bool -> f () -> f () when (Bit sample Bit -> Bit -> Bool forall a. Eq a => a -> a -> Bool == Bit high) (WriterT (Last (BitVector n)) (StateT (RxState n) Identity) () -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) ()) -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) () -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) () forall a b. (a -> b) -> a -> b $ Last (BitVector n) -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) () forall (m :: Type -> Type) w. Monad m => w -> WriterT w m () tell (Last (BitVector n) -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) ()) -> Last (BitVector n) -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) () forall a b. (a -> b) -> a -> b $ BitVector n -> Last (BitVector n) forall a. a -> Last a forall (f :: Type -> Type) a. Applicative f => a -> f a pure BitVector n xs RxState n -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) () forall s (m :: Type -> Type). MonadState s m => s -> m () put RxState n forall (n :: Nat). RxState n RxIdle where bitDuration1 :: Word32 bitDuration1 = Word32 -> Word32 forall a. Bits a => a -> a half Word32 bitDuration bitDuration2 :: Word32 bitDuration2 = Word32 bitDuration Word32 -> Word32 -> Word32 forall a. Num a => a -> a -> a - Word32 bitDuration1 waitFor :: RxBit n -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) () waitFor = RxState n -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) () forall s (m :: Type -> Type). MonadState s m => s -> m () put (RxState n -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) ()) -> (RxBit n -> RxState n) -> RxBit n -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) () forall b c a. (b -> c) -> (a -> b) -> a -> c . Word32 -> Maybe Bit -> RxBit n -> RxState n forall (n :: Nat). Word32 -> Maybe Bit -> RxBit n -> RxState n RxBit Word32 bitDuration1 Maybe Bit forall a. Maybe a Nothing consume :: Bit -> RxBit n -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) () consume Bit input = RxState n -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) () forall s (m :: Type -> Type). MonadState s m => s -> m () put (RxState n -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) ()) -> (RxBit n -> RxState n) -> RxBit n -> WriterT (Last (BitVector n)) (StateT (RxState n) Identity) () forall b c a. (b -> c) -> (a -> b) -> a -> c . Word32 -> Maybe Bit -> RxBit n -> RxState n forall (n :: Nat). Word32 -> Maybe Bit -> RxBit n -> RxState n RxBit Word32 bitDuration2 (Bit -> Maybe Bit forall a. a -> Maybe a Just Bit input) serialRxDyn :: (KnownNat n, HiddenClockResetEnable dom) => Signal dom Word32 -> Signal dom Bit -> Signal dom (Maybe (BitVector n)) serialRxDyn :: forall (n :: Nat) (dom :: Symbol). (KnownNat n, HiddenClockResetEnable dom) => Signal dom Word32 -> Signal dom Bit -> Signal dom (Maybe (BitVector n)) serialRxDyn Signal dom Word32 bitDuration Signal dom Bit input = ((Word32, Bit) -> State (RxState n) (Maybe (BitVector n))) -> RxState n -> Unbundled dom (Word32, Bit) -> Unbundled dom (Maybe (BitVector n)) forall (dom :: Symbol) s i o. (HiddenClockResetEnable dom, NFDataX s, Bundle i, Bundle o) => (i -> State s o) -> s -> Unbundled dom i -> Unbundled dom o mealyStateB ((Word32 -> Bit -> State (RxState n) (Maybe (BitVector n))) -> (Word32, Bit) -> State (RxState n) (Maybe (BitVector n)) forall a b c. (a -> b -> c) -> (a, b) -> c uncurry Word32 -> Bit -> State (RxState n) (Maybe (BitVector n)) forall (n :: Nat). KnownNat n => Word32 -> Bit -> State (RxState n) (Maybe (BitVector n)) rxStep) RxState n forall (n :: Nat). RxState n RxIdle (Signal dom Word32 bitDuration, Signal dom Bit input) serialRx :: forall n rate dom. (KnownNat n, KnownNat (ClockDivider dom (HzToPeriod rate)), HiddenClockResetEnable dom) => SNat rate -> Signal dom Bit -> Signal dom (Maybe (BitVector n)) serialRx :: forall (n :: Nat) (rate :: Nat) (dom :: Symbol). (KnownNat n, KnownNat (ClockDivider dom (HzToPeriod rate)), HiddenClockResetEnable dom) => SNat rate -> Signal dom Bit -> Signal dom (Maybe (BitVector n)) serialRx SNat rate rate = Signal dom Word32 -> Signal dom Bit -> Signal dom (Maybe (BitVector n)) forall (n :: Nat) (dom :: Symbol). (KnownNat n, HiddenClockResetEnable dom) => Signal dom Word32 -> Signal dom Bit -> Signal dom (Maybe (BitVector n)) serialRxDyn (Signal dom Word32 -> Signal dom Bit -> Signal dom (Maybe (BitVector n))) -> Signal dom Word32 -> Signal dom Bit -> Signal dom (Maybe (BitVector n)) forall a b. (a -> b) -> a -> b $ Word32 -> Signal dom Word32 forall a. a -> Signal dom a forall (f :: Type -> Type) a. Applicative f => a -> f a pure Word32 bitDuration where bitDuration :: Word32 bitDuration = Integer -> Word32 forall a b. (Integral a, Num b) => a -> b fromIntegral (Integer -> Word32) -> (SNat (ClockDivider dom (HzToPeriod rate)) -> Integer) -> SNat (ClockDivider dom (HzToPeriod rate)) -> Word32 forall b c a. (b -> c) -> (a -> b) -> a -> c . SNat (Div (Div (Picoseconds 1000000000000) rate) (DomainConfigurationPeriod (KnownConf dom))) -> Integer SNat (ClockDivider dom (HzToPeriod rate)) -> Integer forall (n :: Nat) (proxy :: Nat -> Type). KnownNat n => proxy n -> Integer natVal (SNat (ClockDivider dom (HzToPeriod rate)) -> Word32) -> SNat (ClockDivider dom (HzToPeriod rate)) -> Word32 forall a b. (a -> b) -> a -> b $ forall (n :: Nat). KnownNat n => SNat n SNat @(ClockDivider dom (HzToPeriod rate))