From 91113bf28942b6a58f1725b2a648b8603c7d1cef Mon Sep 17 00:00:00 2001 From: Tim Wallet Date: Fri, 23 Feb 2024 17:34:21 +0100 Subject: [PATCH] added documentation / style changes --- src/Clash/Cores/Ethernet/PacketStream.hs | 82 ++++++++++++------------ 1 file changed, 41 insertions(+), 41 deletions(-) diff --git a/src/Clash/Cores/Ethernet/PacketStream.hs b/src/Clash/Cores/Ethernet/PacketStream.hs index 0bb796b6..735102bf 100644 --- a/src/Clash/Cores/Ethernet/PacketStream.hs +++ b/src/Clash/Cores/Ethernet/PacketStream.hs @@ -1,67 +1,67 @@ {-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- Hashable (Unsigned n) module Clash.Cores.Ethernet.PacketStream where -import Data.Hashable (Hashable, hashWithSalt) -import Control.DeepSeq (NFData) -import Clash.Prelude hiding (sample) -import Protocols.Internal -import qualified Protocols.Df as Df -import Protocols.DfConv hiding (pure) -import qualified Data.Maybe as Maybe -import Data.Proxy -import Protocols.Hedgehog.Internal import qualified Prelude as P +import Clash.Prelude hiding (sample) -instance (KnownNat n) => Hashable (Unsigned n) -instance (KnownNat n, Hashable a) => Hashable (Vec n a) where - hashWithSalt s v = hashWithSalt s (toList v) - -deriving instance - ( KnownNat dataWidth, NFDataX metaType) - => NFDataX (PacketStreamM2S dataWidth metaType) +import Data.Hashable (Hashable, hashWithSalt) +import Data.Proxy +import qualified Data.Maybe as Maybe -deriving instance - ( KnownNat dataWidth, Eq metaType) - => Eq (PacketStreamM2S dataWidth metaType) +import Control.DeepSeq (NFData) -deriving instance - ( KnownNat n) => Hashable (Index n) +import Protocols.Internal +import Protocols.DfConv hiding (pure) +import Protocols.Hedgehog.Internal +import qualified Protocols.Df as Df -deriving instance - ( KnownNat dataWidth, Hashable metaType) - => Hashable (PacketStreamM2S dataWidth metaType) --- Simplified AXI4-Stream (master to slave). --- We bundled _tstrb, _tdest and _tuser into one big _tmeta field which holds metadata. --- We removed _tid. +-- | Data sent from manager to subordinate, a simplified AXI4-Stream +-- We bundled _tstrb, _tdest and _tuser into one big _meta field which holds metadata. +-- We removed _tid and _tstrb -- No _tvalid, we wrap the Stream into a Maybe where the Stream is Nothing when _tvalid is False. data PacketStreamM2S (dataWidth :: Nat) (metaType :: Type) = PacketStreamM2S { - _data :: Vec dataWidth (Unsigned 8), + _data :: Vec dataWidth (BitVector 8), -- ^ The data to be transmitted _last :: Maybe (Index dataWidth), -- ^ If Nothing, we are not yet at the last byte, otherwise signifies how many bytes of _data are valid _meta :: metaType, -- ^ the metaData of a packet, _meta must be constant during a packet. - _abort :: Bool -- ^ If True, the current transfer is aborted and the slave should ignore the current transfer } deriving (Generic, ShowX, Show, NFData, Bundle) --- Slave to master: only a simple signal which tells the master whether --- the slave is ready to receive data + +-- | Data sent from the subordinate to the manager +-- The only information transmitted is whether the slave is ready to receive data newtype PacketStreamS2M = PacketStreamS2M { _ready :: Bool - -- ^ If True, the slave is ready to receive data + -- ^ Iff True, the slave is ready to receive data } deriving (Generic, ShowX, Show, NFData, Bundle, Eq, NFDataX) +-- This data type is used for communication between components on the FPGA. data PacketStream (dom :: Domain) (dataWidth :: Nat) (metaType :: Type) +instance (KnownNat n) => Hashable (Unsigned n) +instance (KnownNat n, Hashable a) => Hashable (Vec n a) where + hashWithSalt s v = hashWithSalt s (toList v) + +deriving instance + ( KnownNat dataWidth, NFDataX metaType) + => NFDataX (PacketStreamM2S dataWidth metaType) + +deriving instance + ( KnownNat dataWidth, Eq metaType) + => Eq (PacketStreamM2S dataWidth metaType) + +deriving instance (KnownNat n) => Hashable (BitVector n) +deriving instance (KnownNat n) => Hashable (Index n) + +deriving instance + (KnownNat dataWidth, Hashable metaType) + => Hashable (PacketStreamM2S dataWidth metaType) + instance Protocol (PacketStream dom dataWidth metaType) where type Fwd (PacketStream dom dataWidth metaType) = Signal dom (Maybe (PacketStreamM2S dataWidth metaType)) type Bwd (PacketStream dom dataWidth metaType) = Signal dom PacketStreamS2M @@ -76,13 +76,13 @@ instance DfConv (PacketStream dom dataWidth metaType) where toDfCircuit proxy = toDfCircuitHelper proxy s0 blankOtp stateFn where s0 = () blankOtp = Nothing - stateFn ack _ optItem + stateFn ack _ optItem = pure (optItem, Nothing, Maybe.isJust optItem && _ready ack) fromDfCircuit proxy = fromDfCircuitHelper proxy s0 blankOtp stateFn where s0 = () blankOtp = PacketStreamS2M { _ready = False } - stateFn m2s ack _ + stateFn m2s ack _ = pure (PacketStreamS2M {_ready = ack }, m2s, False) instance (KnownDomain dom) => @@ -100,9 +100,9 @@ instance (KnownDomain dom) => = withClockResetEnable clockGen resetGen enableGen $ stall Proxy Proxy conf stallAck stalls -instance (KnownDomain dom) => +instance (KnownDomain dom) => Drivable (PacketStream dom dataWidth metaType) where - type ExpectType (PacketStream dom dataWidth metaType) = + type ExpectType (PacketStream dom dataWidth metaType) = [PacketStreamM2S dataWidth metaType] toSimulateType Proxy = fmap Just