diff --git a/src/Protocols/Axi4/Common.hs b/src/Protocols/Axi4/Common.hs index 451ab081..5cba3efc 100644 --- a/src/Protocols/Axi4/Common.hs +++ b/src/Protocols/Axi4/Common.hs @@ -1,6 +1,7 @@ {-| Types and utilities shared between AXI4, AXI4-Lite, and AXI3. -} +{-# LANGUAGE GADTs #-} {-# LANGUAGE UndecidableInstances #-} module Protocols.Axi4.Common where @@ -15,7 +16,7 @@ import qualified Clash.Prelude as C import Clash.Prelude (type (^), type (-), type (*)) -- strict-tuple -import Data.Tuple.Strict +import Data.Tuple.Strict (T3, T4) -- | Simple wrapper to achieve "named arguments" when instantiating an AXI protocol data IdWidth = IdWidth Nat deriving (Show) @@ -63,6 +64,11 @@ data KeepSize = KeepSize | NoSize deriving (Show) -- | Keep or remove strobe field. See 'Strobe' data KeepStrobe = KeepStrobe | NoStrobe deriving (Show) +-- | Type used to introduce strobe information on the term level +data SKeepStrobe (strobeType :: KeepStrobe) where + SKeepStrobe :: SKeepStrobe 'KeepStrobe + SNoStrobe :: SKeepStrobe 'NoStrobe + -- | Extracts Nat from 'IdWidth', 'AddrWidth', and 'LengthWidth' type family Width (a :: k) :: Nat where Width ('IdWidth n) = n @@ -126,7 +132,7 @@ type family StrobeType (byteSize :: Nat) (keepStrobe :: KeepStrobe) where -- | Enable or disable 'Strobe' type family StrictStrobeType (byteSize :: Nat) (keepStrobe :: KeepStrobe) where - StrictStrobeType byteSize 'KeepStrobe = C.Vec byteSize (C.BitVector 8) + StrictStrobeType byteSize 'KeepStrobe = C.Vec byteSize (Maybe (C.BitVector 8)) StrictStrobeType byteSize 'NoStrobe = C.BitVector (byteSize * 8) -- | Indicates valid bytes on data field. diff --git a/src/Protocols/Axi4/Partial/Full.hs b/src/Protocols/Axi4/Partial/Full.hs index 4e6aaf03..16b82130 100644 --- a/src/Protocols/Axi4/Partial/Full.hs +++ b/src/Protocols/Axi4/Partial/Full.hs @@ -18,8 +18,13 @@ module Protocols.Axi4.Partial.Full , module WriteResponse ) where -import Protocols.Axi4.Partial.Full.ReadAddress as ReadAddress -import Protocols.Axi4.Partial.Full.ReadData as ReadData -import Protocols.Axi4.Partial.Full.WriteAddress as WriteAddress -import Protocols.Axi4.Partial.Full.WriteData as WriteData -import Protocols.Axi4.Partial.Full.WriteResponse as WriteResponse +import Protocols.Axi4.Partial.Full.ReadAddress + as ReadAddress hiding (toStrict, toStrictDf, fromStrict, fromStrictDf) +import Protocols.Axi4.Partial.Full.ReadData + as ReadData hiding (toStrict, toStrictDf, fromStrict, fromStrictDf) +import Protocols.Axi4.Partial.Full.WriteAddress + as WriteAddress hiding (toStrict, toStrictDf, fromStrict, fromStrictDf) +import Protocols.Axi4.Partial.Full.WriteData + as WriteData hiding (toStrict, toStrictDf, fromStrict, fromStrictDf) +import Protocols.Axi4.Partial.Full.WriteResponse + as WriteResponse hiding (toStrict, toStrictDf, fromStrict, fromStrictDf) diff --git a/src/Protocols/Axi4/Partial/Full/ReadAddress.hs b/src/Protocols/Axi4/Partial/Full/ReadAddress.hs index 4b3180df..7c014fff 100644 --- a/src/Protocols/Axi4/Partial/Full/ReadAddress.hs +++ b/src/Protocols/Axi4/Partial/Full/ReadAddress.hs @@ -6,6 +6,7 @@ to the AXI4 specification. {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-missing-fields #-} @@ -14,6 +15,8 @@ module Protocols.Axi4.Partial.Full.ReadAddress ( M2S_ReadAddress(..) , S2M_ReadAddress(..) , Axi4ReadAddress + , toStrict, toStrictDf + , fromStrict, fromStrictDf ) where -- base @@ -31,6 +34,9 @@ import Protocols.Axi4.Common import Protocols.Internal import Protocols.DfLike (DfLike) import qualified Protocols.DfLike as DfLike +import qualified Protocols.Axi4.Strict.Full.ReadAddress as Strict +import qualified Protocols.Df as Df +import Protocols.Df (Df) -- | AXI4 Read Address channel protocol data Axi4ReadAddress @@ -187,3 +193,49 @@ deriving instance , C.NFDataX (PermissionsType kp) , C.NFDataX (QosType kq) ) => C.NFDataX (M2S_ReadAddress kb ksz lw iw aw kr kbl kl kc kp kq userType) + +-- | Convert an 'Axi4ReadAddress' into its strict version +-- 'Strict.Axi4ReadAddress'. The latter is usually preferred in Clash designs +-- as its definitions don't contain partial fields. Note that the functions +-- defined over these circuits operate on @userType@. If you need functions to +-- map over all fields, consider using 'toStrictDf'. +toStrict :: + Circuit + (Axi4ReadAddress dom kb ksz lw iw aw kr kbl kl kc kp kq userType) + (Strict.Axi4ReadAddress dom kb ksz lw iw aw kr kbl kl kc kp kq userType) +toStrict = Circuit (C.unbundle . fmap go . C.bundle) + where + go (M2S_ReadAddress{..}, ack) + | _arvalid = (coerce ack, Strict.M2S_ReadAddress{..}) + | otherwise = (coerce ack, Strict.M2S_NoReadAddress) + +-- | Convert a 'Strict.Axi4ReadAddress' into 'Axi4ReadAddress' +fromStrict :: + Circuit + (Strict.Axi4ReadAddress dom kb ksz lw iw aw kr kbl kl kc kp kq userType) + (Axi4ReadAddress dom kb ksz lw iw aw kr kbl kl kc kp kq userType) +fromStrict = Circuit (C.unbundle . fmap go . C.bundle) + where + go (Strict.M2S_ReadAddress{..}, ack) = (coerce ack, M2S_ReadAddress{_arvalid=True,..}) + go (Strict.M2S_NoReadAddress, ack) = (coerce ack, M2S_ReadAddress{_arvalid=False}) + +-- | Convert an 'Axi4ReadAddress' into its strict 'Df' equivalent. +toStrictDf :: + Circuit + (Axi4ReadAddress dom kb ksz lw iw aw kr kbl kl kc kp kq userType) + (Df dom (Strict.M2S_ReadAddress kb ksz lw iw aw kr kbl kl kc kp kq userType)) +toStrictDf = Circuit (C.unbundle . fmap go . C.bundle) + where + go (M2S_ReadAddress{..}, ack) + | _arvalid = (coerce ack, Df.Data (Strict.M2S_ReadAddress{..})) + | otherwise = (coerce ack, Df.NoData) + +-- | Convert a into 'Axi4ReadAddress' from its Df equivalent +fromStrictDf :: + Circuit + (Df dom (Strict.M2S_ReadAddress kb ksz lw iw aw kr kbl kl kc kp kq userType)) + (Axi4ReadAddress dom kb ksz lw iw aw kr kbl kl kc kp kq userType) +fromStrictDf = Circuit (C.unbundle . fmap go . C.bundle) + where + go (Df.Data (Strict.M2S_ReadAddress{..}), ack) = (coerce ack, M2S_ReadAddress{_arvalid=True,..}) + go (_, ack) = (coerce ack, M2S_ReadAddress{_arvalid=False}) diff --git a/src/Protocols/Axi4/Partial/Full/ReadData.hs b/src/Protocols/Axi4/Partial/Full/ReadData.hs index dfb05c44..ef6244cb 100644 --- a/src/Protocols/Axi4/Partial/Full/ReadData.hs +++ b/src/Protocols/Axi4/Partial/Full/ReadData.hs @@ -6,6 +6,7 @@ to the AXI4 specification. {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-missing-fields #-} @@ -14,6 +15,8 @@ module Protocols.Axi4.Partial.Full.ReadData ( M2S_ReadData(..) , S2M_ReadData(..) , Axi4ReadData + , toStrict, toStrictDf + , fromStrict, fromStrictDf ) where -- base @@ -31,6 +34,9 @@ import Protocols.Axi4.Common import Protocols.Internal import Protocols.DfLike (DfLike) import qualified Protocols.DfLike as DfLike +import qualified Protocols.Axi4.Strict.Full.ReadData as Strict +import qualified Protocols.Df as Df +import Protocols.Df (Df) -- | AXI4 Read Data channel protocol data Axi4ReadData @@ -138,3 +144,49 @@ deriving instance , Show dataType , Show (ResponseType kr) ) => Show (S2M_ReadData kr iw dataType userType) + +-- | Convert an 'Axi4ReadData' into its strict version +-- 'Strict.Axi4ReadData'. The latter is usually preferred in Clash designs +-- as its definitions don't contain partial fields. Note that the functions +-- defined over these circuits operate on @userType@. If you need functions to +-- map over all fields, consider using 'toStrictDf'. +toStrict :: + Circuit + (Axi4ReadData dom kr iw dataType userType) + (Strict.Axi4ReadData dom kr iw dataType userType) +toStrict = Circuit (C.unbundle . fmap go . C.bundle) + where + go (S2M_ReadData{..}, ack) + | _rvalid = (coerce ack, Strict.S2M_ReadData{..}) + | otherwise = (coerce ack, Strict.S2M_NoReadData) + +-- | Convert a 'Strict.Axi4ReadData' into 'Axi4ReadData' +fromStrict :: + Circuit + (Strict.Axi4ReadData dom kr iw dataType userType) + (Axi4ReadData dom kr iw dataType userType) +fromStrict = Circuit (C.unbundle . fmap go . C.bundle) + where + go (Strict.S2M_ReadData{..}, ack) = (coerce ack, S2M_ReadData{_rvalid=True,..}) + go (Strict.S2M_NoReadData, ack) = (coerce ack, S2M_ReadData{_rvalid=False}) + +-- | Convert an 'Axi4ReadData' into its strict 'Df' equivalent. +toStrictDf :: + Circuit + (Axi4ReadData dom kr iw dataType userType) + (Df dom (Strict.S2M_ReadData kr iw dataType userType)) +toStrictDf = Circuit (C.unbundle . fmap go . C.bundle) + where + go (S2M_ReadData{..}, ack) + | _rvalid = (coerce ack, Df.Data (Strict.S2M_ReadData{..})) + | otherwise = (coerce ack, Df.NoData) + +-- | Convert a into 'Axi4ReadData' from its Df equivalent +fromStrictDf :: + Circuit + (Df dom (Strict.S2M_ReadData kr iw dataType userType)) + (Axi4ReadData dom kr iw dataType userType) +fromStrictDf = Circuit (C.unbundle . fmap go . C.bundle) + where + go (Df.Data (Strict.S2M_ReadData{..}), ack) = (coerce ack, S2M_ReadData{_rvalid=True,..}) + go (_, ack) = (coerce ack, S2M_ReadData{_rvalid=False}) diff --git a/src/Protocols/Axi4/Partial/Full/WriteAddress.hs b/src/Protocols/Axi4/Partial/Full/WriteAddress.hs index eb92aad6..572bbbb5 100644 --- a/src/Protocols/Axi4/Partial/Full/WriteAddress.hs +++ b/src/Protocols/Axi4/Partial/Full/WriteAddress.hs @@ -6,6 +6,7 @@ to the AXI4 specification. {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-missing-fields #-} @@ -14,6 +15,8 @@ module Protocols.Axi4.Partial.Full.WriteAddress ( M2S_WriteAddress(..) , S2M_WriteAddress(..) , Axi4WriteAddress + , toStrict, toStrictDf + , fromStrict, fromStrictDf ) where -- base @@ -31,6 +34,9 @@ import Protocols.Axi4.Common import Protocols.Internal import Protocols.DfLike (DfLike) import qualified Protocols.DfLike as DfLike +import qualified Protocols.Axi4.Strict.Full.WriteAddress as Strict +import qualified Protocols.Df as Df +import Protocols.Df (Df) -- | AXI4 Write Address channel protocol data Axi4WriteAddress @@ -187,3 +193,49 @@ deriving instance , C.NFDataX (PermissionsType kp) , C.NFDataX (QosType kq) ) => C.NFDataX (M2S_WriteAddress kb ksz lw iw aw kr kbl kl kc kp kq userType) + +-- | Convert an 'Axi4WriteAddress' into its strict version +-- 'Strict.Axi4WriteAddress'. The latter is usually preferred in Clash designs +-- as its definitions don't contain partial fields. Note that the functions +-- defined over these circuits operate on @userType@. If you need functions to +-- map over all fields, consider using 'toStrictDf'. +toStrict :: + Circuit + (Axi4WriteAddress dom kb ksz lw iw aw kr kbl kl kc kp kq userType) + (Strict.Axi4WriteAddress dom kb ksz lw iw aw kr kbl kl kc kp kq userType) +toStrict = Circuit (C.unbundle . fmap go . C.bundle) + where + go (M2S_WriteAddress{..}, ack) + | _awvalid = (coerce ack, Strict.M2S_WriteAddress{..}) + | otherwise = (coerce ack, Strict.M2S_NoWriteAddress) + +-- | Convert a 'Strict.Axi4WriteAddress' into 'Axi4WriteAddress' +fromStrict :: + Circuit + (Strict.Axi4WriteAddress dom kb ksz lw iw aw kr kbl kl kc kp kq userType) + (Axi4WriteAddress dom kb ksz lw iw aw kr kbl kl kc kp kq userType) +fromStrict = Circuit (C.unbundle . fmap go . C.bundle) + where + go (Strict.M2S_WriteAddress{..}, ack) = (coerce ack, M2S_WriteAddress{_awvalid=True,..}) + go (Strict.M2S_NoWriteAddress, ack) = (coerce ack, M2S_WriteAddress{_awvalid=False}) + +-- | Convert an 'Axi4WriteAddress' into its strict 'Df' equivalent. +toStrictDf :: + Circuit + (Axi4WriteAddress dom kb ksz lw iw aw kr kbl kl kc kp kq userType) + (Df dom (Strict.M2S_WriteAddress kb ksz lw iw aw kr kbl kl kc kp kq userType)) +toStrictDf = Circuit (C.unbundle . fmap go . C.bundle) + where + go (M2S_WriteAddress{..}, ack) + | _awvalid = (coerce ack, Df.Data (Strict.M2S_WriteAddress{..})) + | otherwise = (coerce ack, Df.NoData) + +-- | Convert a into 'Axi4WriteAddress' from its Df equivalent +fromStrictDf :: + Circuit + (Df dom (Strict.M2S_WriteAddress kb ksz lw iw aw kr kbl kl kc kp kq userType)) + (Axi4WriteAddress dom kb ksz lw iw aw kr kbl kl kc kp kq userType) +fromStrictDf = Circuit (C.unbundle . fmap go . C.bundle) + where + go (Df.Data (Strict.M2S_WriteAddress{..}), ack) = (coerce ack, M2S_WriteAddress{_awvalid=True,..}) + go (_, ack) = (coerce ack, M2S_WriteAddress{_awvalid=False}) diff --git a/src/Protocols/Axi4/Partial/Full/WriteData.hs b/src/Protocols/Axi4/Partial/Full/WriteData.hs index 418bf8f1..fbea71b7 100644 --- a/src/Protocols/Axi4/Partial/Full/WriteData.hs +++ b/src/Protocols/Axi4/Partial/Full/WriteData.hs @@ -6,6 +6,7 @@ to the AXI4 specification. {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-missing-fields #-} @@ -14,14 +15,17 @@ module Protocols.Axi4.Partial.Full.WriteData ( M2S_WriteData(..) , S2M_WriteData(..) , Axi4WriteData + , toStrict, toStrictDf + , fromStrict, fromStrictDf ) where -- base import Data.Coerce (coerce) import Data.Kind (Type) +import Data.Maybe (fromMaybe, isJust) +import Data.Proxy import GHC.Generics (Generic) import GHC.TypeNats (Nat) -import Data.Proxy -- clash-prelude import qualified Clash.Prelude as C @@ -32,6 +36,9 @@ import Protocols.Axi4.Common import Protocols.Internal import Protocols.DfLike (DfLike) import qualified Protocols.DfLike as DfLike +import qualified Protocols.Axi4.Strict.Full.WriteData as Strict +import qualified Protocols.Df as Df +import Protocols.Df (Df) -- | AXI4 Write Data channel protocol data Axi4WriteData @@ -132,3 +139,76 @@ deriving instance , Show (StrobeType nBytes ks) , C.KnownNat nBytes ) => Show (M2S_WriteData ks nBytes userType) + +-- | Convert an 'Axi4WriteData' into its strict version +-- 'Strict.Axi4WriteData'. The latter is usually preferred in Clash designs +-- as its definitions don't contain partial fields. Note that the functions +-- defined over these circuits operate on @userType@. If you need functions to +-- map over all fields, consider using 'toStrictDf'. +toStrict :: + C.KnownNat nBytes => + SKeepStrobe ks -> + Circuit + (Axi4WriteData dom ks nBytes userType) + (Strict.Axi4WriteData dom ks nBytes userType) +toStrict SNoStrobe = Circuit (C.unbundle . fmap go . C.bundle) + where + go (M2S_WriteData{..}, ack) + | _wvalid = (coerce ack, Strict.M2S_WriteData{..}) + | otherwise = (coerce ack, Strict.M2S_NoWriteData) +toStrict SKeepStrobe = Circuit (C.unbundle . fmap go . C.bundle) + where + go (M2S_WriteData{..}, ack) + | _wvalid = (coerce ack, Strict.M2S_WriteData{_wdata=strobedData _wdata _wstrb,..}) + | otherwise = (coerce ack, Strict.M2S_NoWriteData) + + strobedData dat strb = C.zipWith orNothing (C.unpack strb) (C.unpack dat) + orNothing p a = if p then Just a else Nothing + +-- | Convert a 'Strict.Axi4WriteData' into 'Axi4WriteData' +fromStrict :: + C.KnownNat nBytes => + SKeepStrobe ks -> + Circuit + (Strict.Axi4WriteData dom ks nBytes userType) + (Axi4WriteData dom ks nBytes userType) +fromStrict SNoStrobe = Circuit (C.unbundle . fmap go . C.bundle) + where + go (Strict.M2S_WriteData{..}, ack) = (coerce ack, M2S_WriteData{_wvalid=True,..}) + go (_, ack) = (coerce ack, M2S_WriteData{_wvalid=False}) +fromStrict SKeepStrobe = Circuit (C.unbundle . fmap go . C.bundle) + where + go (Strict.M2S_WriteData{..}, ack) = + (coerce ack, M2S_WriteData + { _wdata=C.pack (C.map (fromMaybe 0) _wdata) + , _wstrb=C.pack (C.map isJust _wdata) + , _wvalid=True + , .. }) + go (_, ack) = + (coerce ack, M2S_WriteData{_wvalid=False}) + +-- | Convert an 'Axi4WriteData' into its strict 'Df' equivalent. +toStrictDf :: + C.KnownNat nBytes => + SKeepStrobe ks -> + Circuit + (Axi4WriteData dom ks nBytes userType) + (Df dom (Strict.M2S_WriteData ks nBytes userType)) +toStrictDf keepStrobe = + toStrict keepStrobe |> Circuit (C.unbundle . fmap go . C.bundle) + where + go (dat@Strict.M2S_WriteData {}, ack) = (coerce ack, Df.Data dat) + go (_, ack) = (coerce ack, Df.NoData) + +-- | Convert an 'Axi4WriteData' into its strict 'Df' equivalent. +fromStrictDf :: + C.KnownNat nBytes => + SKeepStrobe ks -> + Circuit + (Df dom (Strict.M2S_WriteData ks nBytes userType)) + (Axi4WriteData dom ks nBytes userType) +fromStrictDf keepStrobe = + Circuit (C.unbundle . fmap go . C.bundle) |> fromStrict keepStrobe + where + go (Df.Data dat, ack) = (coerce ack, dat) + go (_, ack) = (coerce ack, Strict.M2S_NoWriteData) diff --git a/src/Protocols/Axi4/Partial/Full/WriteResponse.hs b/src/Protocols/Axi4/Partial/Full/WriteResponse.hs index e1bba4d1..a4ebefbe 100644 --- a/src/Protocols/Axi4/Partial/Full/WriteResponse.hs +++ b/src/Protocols/Axi4/Partial/Full/WriteResponse.hs @@ -6,6 +6,7 @@ to the AXI4 specification. {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-missing-fields #-} @@ -14,6 +15,8 @@ module Protocols.Axi4.Partial.Full.WriteResponse ( M2S_WriteResponse(..) , S2M_WriteResponse(..) , Axi4WriteResponse + , toStrict, toStrictDf + , fromStrict, fromStrictDf ) where -- base @@ -31,6 +34,9 @@ import Protocols.Axi4.Common import Protocols.Internal import Protocols.DfLike (DfLike) import qualified Protocols.DfLike as DfLike +import qualified Protocols.Axi4.Strict.Full.WriteResponse as Strict +import qualified Protocols.Df as Df +import Protocols.Df (Df) -- | AXI4 Read Data channel protocol data Axi4WriteResponse @@ -128,3 +134,49 @@ deriving instance , Show (ResponseType kr) , C.KnownNat (Width iw) ) => Show (S2M_WriteResponse kr iw userType) + +-- | Convert an 'Axi4WriteResponse' into its strict version +-- 'Strict.Axi4WriteResponse'. The latter is usually preferred in Clash designs +-- as its definitions don't contain partial fields. Note that the functions +-- defined over these circuits operate on @userType@. If you need functions to +-- map over all fields, consider using 'toStrictDf'. +toStrict :: + Circuit + (Axi4WriteResponse dom kr iw userType) + (Strict.Axi4WriteResponse dom kr iw userType) +toStrict = Circuit (C.unbundle . fmap go . C.bundle) + where + go (S2M_WriteResponse{..}, ack) + | _bvalid = (coerce ack, Strict.S2M_WriteResponse{..}) + | otherwise = (coerce ack, Strict.S2M_NoWriteResponse) + +-- | Convert a 'Strict.Axi4WriteResponse' into 'Axi4WriteResponse' +fromStrict :: + Circuit + (Strict.Axi4WriteResponse dom kr iw userType) + (Axi4WriteResponse dom kr iw userType) +fromStrict = Circuit (C.unbundle . fmap go . C.bundle) + where + go (Strict.S2M_WriteResponse{..}, ack) = (coerce ack, S2M_WriteResponse{_bvalid=True,..}) + go (Strict.S2M_NoWriteResponse, ack) = (coerce ack, S2M_WriteResponse{_bvalid=False}) + +-- | Convert an 'Axi4WriteResponse' into its strict 'Df' equivalent. +toStrictDf :: + Circuit + (Axi4WriteResponse dom kr iw userType) + (Df dom (Strict.S2M_WriteResponse kr iw userType)) +toStrictDf = Circuit (C.unbundle . fmap go . C.bundle) + where + go (S2M_WriteResponse{..}, ack) + | _bvalid = (coerce ack, Df.Data (Strict.S2M_WriteResponse{..})) + | otherwise = (coerce ack, Df.NoData) + +-- | Convert a into 'Axi4WriteResponse' from its Df equivalent +fromStrictDf :: + Circuit + (Df dom (Strict.S2M_WriteResponse kr iw userType)) + (Axi4WriteResponse dom kr iw userType) +fromStrictDf = Circuit (C.unbundle . fmap go . C.bundle) + where + go (Df.Data (Strict.S2M_WriteResponse{..}), ack) = (coerce ack, S2M_WriteResponse{_bvalid=True,..}) + go (_, ack) = (coerce ack, S2M_WriteResponse{_bvalid=False}) diff --git a/src/Protocols/Axi4/Strict/Full/WriteData.hs b/src/Protocols/Axi4/Strict/Full/WriteData.hs index 2029b850..dcdbcc79 100644 --- a/src/Protocols/Axi4/Strict/Full/WriteData.hs +++ b/src/Protocols/Axi4/Strict/Full/WriteData.hs @@ -95,7 +95,7 @@ instance (C.KnownDomain dom, C.NFDataX userType, C.ShowX userType, Show userType -- | See Table A2-3 "Write data channel signals". If strobing is kept, the data -- will be a vector of 'Maybe' bytes. If strobing is not kept, data will be a --- 'BitVector'. +-- 'C.BitVector'. data M2S_WriteData (ks :: KeepStrobe) (nBytes :: Nat)