From 6026ee92f1b656c78acce15184d34fcf93ab4ec9 Mon Sep 17 00:00:00 2001 From: Sam Uwe Alws Date: Fri, 26 Aug 2022 01:45:27 -0500 Subject: [PATCH] Small improvements for DFConv and Axi4 related (#45) --- clash-protocols.cabal | 4 +- src/Protocols/Axi4/Common.hs | 42 ++- src/Protocols/Axi4/ReadAddress.hs | 87 ++--- src/Protocols/Axi4/ReadData.hs | 17 +- src/Protocols/Axi4/WriteAddress.hs | 87 ++--- src/Protocols/Axi4/WriteData.hs | 17 +- src/Protocols/Axi4/WriteResponse.hs | 17 +- src/Protocols/DfConv.hs | 97 +++--- tests/Tests/Protocols.hs | 6 +- .../Protocols/{AvalonMemMap.hs => Avalon.hs} | 31 +- tests/Tests/Protocols/Axi4.hs | 303 ++++++++++++++++++ tests/Tests/Protocols/DfConv.hs | 70 +--- 12 files changed, 565 insertions(+), 213 deletions(-) rename tests/Tests/Protocols/{AvalonMemMap.hs => Avalon.hs} (85%) create mode 100644 tests/Tests/Protocols/Axi4.hs diff --git a/clash-protocols.cabal b/clash-protocols.cabal index 4dc372fe..98eafe28 100644 --- a/clash-protocols.cabal +++ b/clash-protocols.cabal @@ -189,7 +189,8 @@ test-suite unittests Tests.Protocols Tests.Protocols.Df Tests.Protocols.DfConv - Tests.Protocols.AvalonMemMap + Tests.Protocols.Avalon + Tests.Protocols.Axi4 Tests.Protocols.Plugin Tests.Protocols.Wishbone @@ -203,6 +204,7 @@ test-suite unittests extra, hashable, hedgehog, + strict-tuple, tasty >= 1.2 && < 1.5, tasty-hedgehog >= 1.2, tasty-th, diff --git a/src/Protocols/Axi4/Common.hs b/src/Protocols/Axi4/Common.hs index 793a5dab..e810e902 100644 --- a/src/Protocols/Axi4/Common.hs +++ b/src/Protocols/Axi4/Common.hs @@ -4,12 +4,14 @@ Types and utilities shared between AXI4, AXI4-Lite, and AXI3. {-# LANGUAGE GADTs #-} {-# LANGUAGE TypeFamilyDependencies #-} {-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} -- NFDataX and ShowX for T3 and T4 module Protocols.Axi4.Common where -- base import GHC.Generics (Generic) import GHC.TypeNats (Nat) +import Control.DeepSeq (NFData) -- clash-prelude import qualified Clash.Prelude as C @@ -20,6 +22,32 @@ import Data.Tuple.Strict (T3, T4) import Protocols.Internal +deriving instance + ( C.NFDataX a + , C.NFDataX b + , C.NFDataX c + ) => C.NFDataX (T3 a b c) + +deriving instance + ( C.NFDataX a + , C.NFDataX b + , C.NFDataX c + , C.NFDataX d + ) => C.NFDataX (T4 a b c d) + +deriving instance + ( C.ShowX a + , C.ShowX b + , C.ShowX c + ) => C.ShowX (T3 a b c) + +deriving instance + ( C.ShowX a + , C.ShowX b + , C.ShowX c + , C.ShowX d + ) => C.ShowX (T4 a b c d) + -- | Enables or disables 'BurstMode' type BurstType (keep :: Bool) = KeepType keep BurstMode @@ -136,7 +164,7 @@ data BurstMode -- This burst type is used for cache line accesses. -- | BmWrap - deriving (Show, C.ShowX, Generic, C.NFDataX, Eq) + deriving (Show, C.ShowX, Generic, C.NFDataX, NFData, Eq) -- | The maximum number of bytes to transfer in each data transfer, or beat, -- in a burst. @@ -149,7 +177,7 @@ data BurstSize | Bs32 | Bs64 | Bs128 - deriving (Show, C.ShowX, Generic, C.NFDataX) + deriving (Show, C.ShowX, Generic, C.NFDataX, NFData, Eq) -- | Convert burst size to a numeric value burstSizeToNum :: Num a => BurstSize -> a @@ -165,14 +193,17 @@ burstSizeToNum = \case -- | Whether a transaction is bufferable data Bufferable = NonBufferable | Bufferable + deriving (Show, C.ShowX, Generic, C.NFDataX, NFData, Eq) -- | When set to "LookupCache", it is recommended that this transaction is -- allocated in the cache for performance reasons. data Allocate = NoLookupCache | LookupCache + deriving (Show, C.ShowX, Generic, C.NFDataX, NFData, Eq) -- | When set to "OtherLookupCache", it is recommended that this transaction is -- allocated in the cache for performance reasons. data OtherAllocate = OtherNoLookupCache | OtherLookupCache + deriving (Show, C.ShowX, Generic, C.NFDataX, NFData, Eq) -- | See Table A4-3 AWCACHE bit allocations type Cache = T4 Bufferable Modifiable OtherAllocate Allocate @@ -191,29 +222,33 @@ data Resp -- | Decode error. Generated, typically by an interconnect component, to -- indicate that there is no slave at the transaction address. | RDecodeError - deriving (Show, C.ShowX, Generic, C.NFDataX) + deriving (Show, C.ShowX, Generic, C.NFDataX, NFData, Eq) -- | Whether a resource is accessed with exclusive access or not data AtomicAccess = NonExclusiveAccess | ExclusiveAccess + deriving (Show, C.ShowX, Generic, C.NFDataX, NFData, Eq) -- | Whether transaction can be modified data Modifiable = Modifiable | NonModifiable + deriving (Show, C.ShowX, Generic, C.NFDataX, NFData, Eq) -- | An AXI master might support Secure and Non-secure operating states, and -- extend this concept of security to memory access. data Secure = Secure | NonSecure + deriving (Show, C.ShowX, Generic, C.NFDataX, NFData, Eq) -- | An AXI master might support more than one level of operating privilege, -- and extend this concept of privilege to memory access. data Privileged = NotPrivileged | Privileged + deriving (Show, C.ShowX, Generic, C.NFDataX, NFData, Eq) -- | Whether the transaction is an instruction access or a data access. The AXI -- protocol defines this indication as a hint. It is not accurate in all cases, @@ -224,3 +259,4 @@ data Privileged data InstructionOrData = Data | Instruction + deriving (Show, C.ShowX, Generic, C.NFDataX, NFData, Eq) diff --git a/src/Protocols/Axi4/ReadAddress.hs b/src/Protocols/Axi4/ReadAddress.hs index fc90ca07..e17d7d1c 100644 --- a/src/Protocols/Axi4/ReadAddress.hs +++ b/src/Protocols/Axi4/ReadAddress.hs @@ -18,7 +18,7 @@ module Protocols.Axi4.ReadAddress -- * configuration , Axi4ReadAddressConfig(..) - , GoodAxi4ReadAddressConfig + , KnownAxi4ReadAddressConfig , ARKeepBurst , ARKeepSize , ARIdWidth @@ -37,6 +37,7 @@ module Protocols.Axi4.ReadAddress ) where -- base +import Control.DeepSeq (NFData) import Data.Coerce import Data.Kind (Type) import GHC.Generics (Generic) @@ -187,7 +188,7 @@ newtype S2M_ReadAddress = S2M_ReadAddress -- | Shorthand for a "well-behaved" read address config, -- so that we don't need to write out a bunch of type constraints later. -- Holds for every configuration; don't worry about implementing this class. -class +type KnownAxi4ReadAddressConfig conf = ( KeepTypeClass (ARKeepBurst conf) , KeepTypeClass (ARKeepSize conf) , KeepTypeClass (ARKeepRegion conf) @@ -200,37 +201,14 @@ class , C.KnownNat (ARIdWidth conf) , C.KnownNat (ARAddrWidth conf) - , Show (RegionType (ARKeepRegion conf)) - , Show (BurstLengthType (ARKeepBurstLength conf)) - , Show (SizeType (ARKeepSize conf)) - , Show (BurstType (ARKeepBurst conf)) - , Show (LockType (ARKeepLock conf)) - , Show (CacheType (ARKeepCache conf)) - , Show (PermissionsType (ARKeepPermissions conf)) - , Show (QosType (ARKeepQos conf)) - - , C.NFDataX (RegionType (ARKeepRegion conf)) - , C.NFDataX (BurstLengthType (ARKeepBurstLength conf)) - , C.NFDataX (SizeType (ARKeepSize conf)) - , C.NFDataX (BurstType (ARKeepBurst conf)) - , C.NFDataX (LockType (ARKeepLock conf)) - , C.NFDataX (CacheType (ARKeepCache conf)) - , C.NFDataX (PermissionsType (ARKeepPermissions conf)) - , C.NFDataX (QosType (ARKeepQos conf)) - ) => GoodAxi4ReadAddressConfig conf - -instance - ( KeepTypeClass (ARKeepBurst conf) - , KeepTypeClass (ARKeepSize conf) - , KeepTypeClass (ARKeepRegion conf) - , KeepTypeClass (ARKeepBurstLength conf) - , KeepTypeClass (ARKeepLock conf) - , KeepTypeClass (ARKeepCache conf) - , KeepTypeClass (ARKeepPermissions conf) - , KeepTypeClass (ARKeepQos conf) - - , C.KnownNat (ARIdWidth conf) - , C.KnownNat (ARAddrWidth conf) + , C.ShowX (RegionType (ARKeepRegion conf)) + , C.ShowX (BurstLengthType (ARKeepBurstLength conf)) + , C.ShowX (SizeType (ARKeepSize conf)) + , C.ShowX (BurstType (ARKeepBurst conf)) + , C.ShowX (LockType (ARKeepLock conf)) + , C.ShowX (CacheType (ARKeepCache conf)) + , C.ShowX (PermissionsType (ARKeepPermissions conf)) + , C.ShowX (QosType (ARKeepQos conf)) , Show (RegionType (ARKeepRegion conf)) , Show (BurstLengthType (ARKeepBurstLength conf)) @@ -249,16 +227,34 @@ instance , C.NFDataX (CacheType (ARKeepCache conf)) , C.NFDataX (PermissionsType (ARKeepPermissions conf)) , C.NFDataX (QosType (ARKeepQos conf)) - ) => GoodAxi4ReadAddressConfig conf + + , NFData (RegionType (ARKeepRegion conf)) + , NFData (BurstLengthType (ARKeepBurstLength conf)) + , NFData (SizeType (ARKeepSize conf)) + , NFData (BurstType (ARKeepBurst conf)) + , NFData (LockType (ARKeepLock conf)) + , NFData (CacheType (ARKeepCache conf)) + , NFData (PermissionsType (ARKeepPermissions conf)) + , NFData (QosType (ARKeepQos conf)) + + , Eq (RegionType (ARKeepRegion conf)) + , Eq (BurstLengthType (ARKeepBurstLength conf)) + , Eq (SizeType (ARKeepSize conf)) + , Eq (BurstType (ARKeepBurst conf)) + , Eq (LockType (ARKeepLock conf)) + , Eq (CacheType (ARKeepCache conf)) + , Eq (PermissionsType (ARKeepPermissions conf)) + , Eq (QosType (ARKeepQos conf)) + ) deriving instance - ( GoodAxi4ReadAddressConfig conf + ( KnownAxi4ReadAddressConfig conf , Show userType ) => Show (M2S_ReadAddress conf userType) deriving instance - ( GoodAxi4ReadAddressConfig conf + ( KnownAxi4ReadAddressConfig conf , C.NFDataX userType ) => C.NFDataX (M2S_ReadAddress conf userType) @@ -307,15 +303,30 @@ data Axi4ReadAddressInfo (conf :: Axi4ReadAddressConfig) (userType :: Type) deriving (Generic) deriving instance - ( GoodAxi4ReadAddressConfig conf + ( KnownAxi4ReadAddressConfig conf , Show userType ) => Show (Axi4ReadAddressInfo conf userType) deriving instance - ( GoodAxi4ReadAddressConfig conf + ( KnownAxi4ReadAddressConfig conf + , C.ShowX userType ) => + C.ShowX (Axi4ReadAddressInfo conf userType) + +deriving instance + ( KnownAxi4ReadAddressConfig conf , C.NFDataX userType ) => C.NFDataX (Axi4ReadAddressInfo conf userType) +deriving instance + ( KnownAxi4ReadAddressConfig conf + , NFData userType ) => + NFData (Axi4ReadAddressInfo conf userType) + +deriving instance + ( KnownAxi4ReadAddressConfig conf + , Eq userType ) => + Eq (Axi4ReadAddressInfo conf userType) + -- | Convert 'M2S_ReadAddress' to 'Axi4ReadAddressInfo', dropping some info axi4ReadAddrMsgToReadAddrInfo :: M2S_ReadAddress conf userType diff --git a/src/Protocols/Axi4/ReadData.hs b/src/Protocols/Axi4/ReadData.hs index 19dac4e1..f52cce0a 100644 --- a/src/Protocols/Axi4/ReadData.hs +++ b/src/Protocols/Axi4/ReadData.hs @@ -17,7 +17,7 @@ module Protocols.Axi4.ReadData -- * configuration , Axi4ReadDataConfig(..) - , GoodAxi4ReadDataConfig + , KnownAxi4ReadDataConfig , RKeepResponse , RIdWidth ) where @@ -101,29 +101,22 @@ newtype M2S_ReadData = M2S_ReadData { _rready :: Bool } -- | Shorthand for a "well-behaved" read data config, -- so that we don't need to write out a bunch of type constraints later. -- Holds for every configuration; don't worry about implementing this class. -class +type KnownAxi4ReadDataConfig conf = ( KeepTypeClass (RKeepResponse conf) , C.KnownNat (RIdWidth conf) , Show (ResponseType (RKeepResponse conf)) , C.NFDataX (ResponseType (RKeepResponse conf)) - ) => GoodAxi4ReadDataConfig conf - -instance - ( KeepTypeClass (RKeepResponse conf) - , C.KnownNat (RIdWidth conf) - , Show (ResponseType (RKeepResponse conf)) - , C.NFDataX (ResponseType (RKeepResponse conf)) - ) => GoodAxi4ReadDataConfig conf + ) deriving instance - ( GoodAxi4ReadDataConfig conf + ( KnownAxi4ReadDataConfig conf , Show userType , Show dataType ) => Show (S2M_ReadData conf userType dataType) deriving instance - ( GoodAxi4ReadDataConfig conf + ( KnownAxi4ReadDataConfig conf , C.NFDataX userType , C.NFDataX dataType ) => diff --git a/src/Protocols/Axi4/WriteAddress.hs b/src/Protocols/Axi4/WriteAddress.hs index 35e0d40b..f6bbf8ac 100644 --- a/src/Protocols/Axi4/WriteAddress.hs +++ b/src/Protocols/Axi4/WriteAddress.hs @@ -18,7 +18,7 @@ module Protocols.Axi4.WriteAddress -- * configuration , Axi4WriteAddressConfig(..) - , GoodAxi4WriteAddressConfig + , KnownAxi4WriteAddressConfig , AWKeepBurst , AWKeepSize , AWIdWidth @@ -37,6 +37,7 @@ module Protocols.Axi4.WriteAddress ) where -- base +import Control.DeepSeq (NFData) import Data.Coerce (coerce) import Data.Kind (Type) import GHC.Generics (Generic) @@ -186,7 +187,7 @@ newtype S2M_WriteAddress = S2M_WriteAddress { _awready :: Bool } -- | Shorthand for a "well-behaved" write address config, -- so that we don't need to write out a bunch of type constraints later. -- Holds for every configuration; don't worry about implementing this class. -class +type KnownAxi4WriteAddressConfig conf = ( KeepTypeClass (AWKeepBurst conf) , KeepTypeClass (AWKeepSize conf) , KeepTypeClass (AWKeepRegion conf) @@ -199,37 +200,14 @@ class , C.KnownNat (AWIdWidth conf) , C.KnownNat (AWAddrWidth conf) - , Show (RegionType (AWKeepRegion conf)) - , Show (BurstLengthType (AWKeepBurstLength conf)) - , Show (SizeType (AWKeepSize conf)) - , Show (BurstType (AWKeepBurst conf)) - , Show (LockType (AWKeepLock conf)) - , Show (CacheType (AWKeepCache conf)) - , Show (PermissionsType (AWKeepPermissions conf)) - , Show (QosType (AWKeepQos conf)) - - , C.NFDataX (RegionType (AWKeepRegion conf)) - , C.NFDataX (BurstLengthType (AWKeepBurstLength conf)) - , C.NFDataX (SizeType (AWKeepSize conf)) - , C.NFDataX (BurstType (AWKeepBurst conf)) - , C.NFDataX (LockType (AWKeepLock conf)) - , C.NFDataX (CacheType (AWKeepCache conf)) - , C.NFDataX (PermissionsType (AWKeepPermissions conf)) - , C.NFDataX (QosType (AWKeepQos conf)) - ) => GoodAxi4WriteAddressConfig conf - -instance - ( KeepTypeClass (AWKeepBurst conf) - , KeepTypeClass (AWKeepSize conf) - , KeepTypeClass (AWKeepRegion conf) - , KeepTypeClass (AWKeepBurstLength conf) - , KeepTypeClass (AWKeepLock conf) - , KeepTypeClass (AWKeepCache conf) - , KeepTypeClass (AWKeepPermissions conf) - , KeepTypeClass (AWKeepQos conf) - - , C.KnownNat (AWIdWidth conf) - , C.KnownNat (AWAddrWidth conf) + , C.ShowX (RegionType (AWKeepRegion conf)) + , C.ShowX (BurstLengthType (AWKeepBurstLength conf)) + , C.ShowX (SizeType (AWKeepSize conf)) + , C.ShowX (BurstType (AWKeepBurst conf)) + , C.ShowX (LockType (AWKeepLock conf)) + , C.ShowX (CacheType (AWKeepCache conf)) + , C.ShowX (PermissionsType (AWKeepPermissions conf)) + , C.ShowX (QosType (AWKeepQos conf)) , Show (RegionType (AWKeepRegion conf)) , Show (BurstLengthType (AWKeepBurstLength conf)) @@ -248,16 +226,34 @@ instance , C.NFDataX (CacheType (AWKeepCache conf)) , C.NFDataX (PermissionsType (AWKeepPermissions conf)) , C.NFDataX (QosType (AWKeepQos conf)) - ) => GoodAxi4WriteAddressConfig conf + + , NFData (RegionType (AWKeepRegion conf)) + , NFData (BurstLengthType (AWKeepBurstLength conf)) + , NFData (SizeType (AWKeepSize conf)) + , NFData (BurstType (AWKeepBurst conf)) + , NFData (LockType (AWKeepLock conf)) + , NFData (CacheType (AWKeepCache conf)) + , NFData (PermissionsType (AWKeepPermissions conf)) + , NFData (QosType (AWKeepQos conf)) + + , Eq (RegionType (AWKeepRegion conf)) + , Eq (BurstLengthType (AWKeepBurstLength conf)) + , Eq (SizeType (AWKeepSize conf)) + , Eq (BurstType (AWKeepBurst conf)) + , Eq (LockType (AWKeepLock conf)) + , Eq (CacheType (AWKeepCache conf)) + , Eq (PermissionsType (AWKeepPermissions conf)) + , Eq (QosType (AWKeepQos conf)) + ) deriving instance - ( GoodAxi4WriteAddressConfig conf + ( KnownAxi4WriteAddressConfig conf , Show userType ) => Show (M2S_WriteAddress conf userType) deriving instance - ( GoodAxi4WriteAddressConfig conf + ( KnownAxi4WriteAddressConfig conf , C.NFDataX userType ) => C.NFDataX (M2S_WriteAddress conf userType) @@ -300,15 +296,30 @@ data Axi4WriteAddressInfo (conf :: Axi4WriteAddressConfig) (userType :: Type) deriving (Generic) deriving instance - ( GoodAxi4WriteAddressConfig conf + ( KnownAxi4WriteAddressConfig conf , Show userType ) => Show (Axi4WriteAddressInfo conf userType) deriving instance - ( GoodAxi4WriteAddressConfig conf + ( KnownAxi4WriteAddressConfig conf + , C.ShowX userType ) => + C.ShowX (Axi4WriteAddressInfo conf userType) + +deriving instance + ( KnownAxi4WriteAddressConfig conf , C.NFDataX userType ) => C.NFDataX (Axi4WriteAddressInfo conf userType) +deriving instance + ( KnownAxi4WriteAddressConfig conf + , NFData userType ) => + NFData (Axi4WriteAddressInfo conf userType) + +deriving instance + ( KnownAxi4WriteAddressConfig conf + , Eq userType ) => + Eq (Axi4WriteAddressInfo conf userType) + -- | Convert 'M2S_WriteAddress' to 'Axi4WriteAddressInfo', dropping some info axi4WriteAddrMsgToWriteAddrInfo :: M2S_WriteAddress conf userType diff --git a/src/Protocols/Axi4/WriteData.hs b/src/Protocols/Axi4/WriteData.hs index f86b6942..4803759b 100644 --- a/src/Protocols/Axi4/WriteData.hs +++ b/src/Protocols/Axi4/WriteData.hs @@ -17,7 +17,7 @@ module Protocols.Axi4.WriteData -- * configuration , Axi4WriteDataConfig(..) - , GoodAxi4WriteDataConfig + , KnownAxi4WriteDataConfig , WKeepStrobe , WNBytes ) where @@ -95,28 +95,21 @@ newtype S2M_WriteData = S2M_WriteData { _wready :: Bool } -- | Shorthand for a "well-behaved" write data config, -- so that we don't need to write out a bunch of type constraints later. -- Holds for every configuration; don't worry about implementing this class. -class +type KnownAxi4WriteDataConfig conf = ( KeepStrobeClass (WKeepStrobe conf) , C.KnownNat (WNBytes conf) , Show (StrobeDataType (WKeepStrobe conf)) , C.NFDataX (StrobeDataType (WKeepStrobe conf)) - ) => GoodAxi4WriteDataConfig conf - -instance - ( KeepStrobeClass (WKeepStrobe conf) - , C.KnownNat (WNBytes conf) - , Show (StrobeDataType (WKeepStrobe conf)) - , C.NFDataX (StrobeDataType (WKeepStrobe conf)) - ) => GoodAxi4WriteDataConfig conf + ) deriving instance - ( GoodAxi4WriteDataConfig conf + ( KnownAxi4WriteDataConfig conf , Show userType ) => Show (M2S_WriteData conf userType) deriving instance - ( GoodAxi4WriteDataConfig conf + ( KnownAxi4WriteDataConfig conf , C.NFDataX userType ) => C.NFDataX (M2S_WriteData conf userType) diff --git a/src/Protocols/Axi4/WriteResponse.hs b/src/Protocols/Axi4/WriteResponse.hs index 28a826f4..d644b788 100644 --- a/src/Protocols/Axi4/WriteResponse.hs +++ b/src/Protocols/Axi4/WriteResponse.hs @@ -17,7 +17,7 @@ module Protocols.Axi4.WriteResponse -- * configuration , Axi4WriteResponseConfig(..) - , GoodAxi4WriteResponseConfig + , KnownAxi4WriteResponseConfig , BKeepResponse , BIdWidth ) where @@ -91,28 +91,21 @@ newtype M2S_WriteResponse = M2S_WriteResponse { _bready :: Bool } -- | Shorthand for a "well-behaved" write response config, -- so that we don't need to write out a bunch of type constraints later. -- Holds for every configuration; don't worry about implementing this class. -class +type KnownAxi4WriteResponseConfig conf = ( KeepTypeClass (BKeepResponse conf) , C.KnownNat (BIdWidth conf) , Show (ResponseType (BKeepResponse conf)) , C.NFDataX (ResponseType (BKeepResponse conf)) - ) => GoodAxi4WriteResponseConfig conf - -instance - ( KeepTypeClass (BKeepResponse conf) - , C.KnownNat (BIdWidth conf) - , Show (ResponseType (BKeepResponse conf)) - , C.NFDataX (ResponseType (BKeepResponse conf)) - ) => GoodAxi4WriteResponseConfig conf + ) deriving instance - ( GoodAxi4WriteResponseConfig conf + ( KnownAxi4WriteResponseConfig conf , Show userType ) => Show (S2M_WriteResponse conf userType) deriving instance - ( GoodAxi4WriteResponseConfig conf + ( KnownAxi4WriteResponseConfig conf , C.NFDataX userType ) => C.NFDataX (S2M_WriteResponse conf userType) diff --git a/src/Protocols/DfConv.hs b/src/Protocols/DfConv.hs index 9ca0d59d..8858cc86 100644 --- a/src/Protocols/DfConv.hs +++ b/src/Protocols/DfConv.hs @@ -80,7 +80,7 @@ import Clash.Prelude hiding (map, fst, snd, zipWith, const, pure, filter, either, zip, select, sample, simulate) import qualified Clash.Prelude as C import qualified Data.Bifunctor as B -import Data.Maybe (fromMaybe, isNothing) +import Data.Maybe (isJust) import Data.Proxy (Proxy(..)) import Data.Tuple (swap) import GHC.Stack (HasCallStack) @@ -227,8 +227,18 @@ instance DfConv (Df dom a, Reverse (Df dom b)) where type Dom (Df dom a, Reverse (Df dom b)) = dom type BwdPayload (Df dom a, Reverse (Df dom b)) = b type FwdPayload (Df dom a, Reverse (Df dom b)) = a - toDfCircuit _ = Circuit swap - fromDfCircuit _ = Circuit swap + toDfCircuit _ = idC + fromDfCircuit _ = idC + + +-- DfConv instance for Reverse + +instance (DfConv a) => DfConv (Reverse a) where + type Dom (Reverse a) = Dom a + type BwdPayload (Reverse a) = FwdPayload a + type FwdPayload (Reverse a) = BwdPayload a + toDfCircuit _ = mapCircuit swap swap id id $ reverseCircuit $ fromDfCircuit (Proxy @a) + fromDfCircuit _ = mapCircuit id id swap swap $ reverseCircuit $ toDfCircuit (Proxy @a) -- DfConv instances for Df @@ -248,9 +258,9 @@ instance (NFDataX dat) => DfConv (Df dom dat) where -- burst length you input. Subordinate end (fromDfCircuit) allows for any burst -- length. instance - ( GoodAxi4WriteAddressConfig confAW - , GoodAxi4WriteDataConfig confW - , GoodAxi4WriteResponseConfig confB + ( KnownAxi4WriteAddressConfig confAW + , KnownAxi4WriteDataConfig confW + , KnownAxi4WriteResponseConfig confB , NFDataX userAW , NFDataX userB , AWIdWidth confAW ~ BIdWidth confB ) => @@ -294,25 +304,28 @@ instance ) stateFn (addrAck, dataAck, respVal) dfAckIn dfDatIn = do - addrMsg <- sendAddr addrAck dfDatIn - (dataMsg, dfAckOut) <- sendData dataAck dfDatIn - (respAck, dfDatOut) <- receiveResp respVal dfAckIn + st0 <- get + let -- neeeded to prevent infinite loop when two axi4 circuits are connected + (addrMsg, st1) = runState (sendAddr addrAck dfDatIn) st0 + ((dataMsg, dfAckOut), st2) = runState (sendData dataAck dfDatIn) st1 + ((respAck, dfDatOut), st3) = runState (receiveResp respVal dfAckIn) st2 + put st3 P.pure ((addrMsg, dataMsg, respAck), dfDatOut, dfAckOut) sendAddr _ Nothing = P.pure M2S_NoWriteAddress - sendAddr S2M_WriteAddress{_awready} (Just (info, _, burst, _, _)) = do + sendAddr addrAck (Just (info, _, burst, _, _)) = do (addrReceived, b) <- get - put (_awready || addrReceived, b) + put (addrReceived || _awready addrAck, b) P.pure $ if addrReceived then M2S_NoWriteAddress else axi4WriteAddrMsgFromWriteAddrInfo - (toKeepType 1) + (toKeepType 0) burst info sendData _ Nothing = P.pure (M2S_NoWriteData, False) - sendData S2M_WriteData{_wready} (Just (_, _, _, dat, user)) = do + sendData dataAck (Just (_, _, _, dat, user)) = do (addrReceived, dataReceived) <- get - put (addrReceived, _wready || dataReceived) + put (addrReceived, dataReceived || _wready dataAck) P.pure $ if (not addrReceived || dataReceived) then (M2S_NoWriteData, False) else @@ -321,7 +334,7 @@ instance , _wlast = True , _wuser = user } - , _wready) + , _wready dataAck) receiveResp S2M_NoWriteResponse _ = P.pure (M2S_WriteResponse { _bready = False }, Nothing) @@ -342,17 +355,21 @@ instance , S2M_WriteData{_wready = False} , S2M_NoWriteResponse) - stateFn (wAddrVal, wDataVal, wRespAck) dfAckIn dfDatIn = do - wAddrAck <- processWAddr wAddrVal - (wDataAck, dfDatOut) <- processWData wDataVal dfAckIn - (wRespVal, dfAckOut) <- sendWResp wRespAck dfDatIn - P.pure ((wAddrAck, wDataAck, wRespVal), dfDatOut, dfAckOut) + stateFn (addrVal, dataVal, respAck) dfAckIn dfDatIn = do + st0 <- get + let -- neeeded to prevent infinite loop when two axi4 circuits are connected + (addrAck, st1) = runState (processWAddr addrVal) st0 + ((dataAck, dfDatOut), st2) = runState (processWData dataVal dfAckIn) st1 + ((respVal, dfAckOut), st3) = runState (sendWResp respAck dfDatIn) st2 + put st3 + P.pure ((addrAck, dataAck, respVal), dfDatOut, dfAckOut) processWAddr M2S_NoWriteAddress = P.pure (S2M_WriteAddress{_awready = False}) processWAddr msg = do (writingInfo,b) <- get - when (isNothing writingInfo) $ - put (Just (axi4WriteAddrMsgToWriteAddrInfo msg, _awlen msg, _awburst msg), b) + put ( writingInfo <|> + Just (axi4WriteAddrMsgToWriteAddrInfo msg, _awlen msg, _awburst msg) + , b) P.pure (S2M_WriteAddress{_awready = True}) processWData M2S_NoWriteData _ = P.pure (S2M_WriteData{_wready = False}, Nothing) @@ -368,18 +385,18 @@ instance P.pure ( S2M_WriteData{_wready = dfAckIn} , Just (info, len, burst, _wdata, _wuser)) - sendWResp wRespAck dfDatIn = do + sendWResp respAck dfDatIn = do (a, respID) <- get - let (wRespVal, dfAckOut) = case (respID, dfDatIn) of + let (respVal, dfAckOut) = case (respID, dfDatIn) of (Just _bid, Just (_bresp, _buser)) - -> (S2M_WriteResponse{..}, _bready wRespAck) + -> (S2M_WriteResponse{..}, _bready respAck) _ -> (S2M_NoWriteResponse, False) when dfAckOut $ put (a, Nothing) - P.pure (wRespVal, dfAckOut) + P.pure (respVal, dfAckOut) instance - ( GoodAxi4ReadAddressConfig confAR - , GoodAxi4ReadDataConfig confR + ( KnownAxi4ReadAddressConfig confAR + , KnownAxi4ReadDataConfig confR , NFDataX userR , NFDataX dat , ARIdWidth confAR ~ RIdWidth confR ) => @@ -417,7 +434,7 @@ instance let readAddrMsg = processAddrInfo dfDatIn in P.pure ( (readAddrMsg, M2S_ReadData { _rready = dfAckIn }) , processReadVal readVal - , getDfAckOut addrAck readAddrMsg) + , isJust dfDatIn && getDfAckOut addrAck readAddrMsg) processAddrInfo = maybe M2S_NoReadAddress axi4ReadAddrMsgFromReadAddrInfo @@ -436,26 +453,32 @@ instance blankOtp = (S2M_ReadAddress { _arready = False }, S2M_NoReadData) stateFn (addrVal, dataAck) dfAckIn dfDatIn = do - (addrAck, dfDatOut) <- processAddr addrVal dfAckIn - (dataVal, dfAckOut) <- sendData dfDatIn dataAck + st0 <- get + let -- neeeded to prevent infinite loop when two axi4 circuits are connected + ((addrAck, dfDatOut), st1) = runState (processAddr addrVal dfAckIn) st0 + ((dataVal, dfAckOut), st2) = runState (sendData dfDatIn dataAck) st1 + put st2 P.pure ((addrAck,dataVal),dfDatOut,dfAckOut) processAddr M2S_NoReadAddress _ = P.pure (S2M_ReadAddress { _arready = False }, Nothing) processAddr msg dfAckIn = do (burstLenLeft,_) <- get - when (burstLenLeft == 0) $ - put (succResizing $ fromMaybe 0 (fromKeepType $ _arlen msg), _arid msg) - P.pure ( S2M_ReadAddress{ _arready = burstLenLeft == 0 && dfAckIn } - , Just (axi4ReadAddrMsgToReadAddrInfo msg) ) + case burstLenLeft of + 0 -> do + put (succResizing $ fromKeepTypeDef 0 $ _arlen msg, _arid msg) + P.pure ( S2M_ReadAddress{ _arready = dfAckIn } + , Just (axi4ReadAddrMsgToReadAddrInfo msg) ) + _ -> P.pure ( S2M_ReadAddress{ _arready = False } + , Nothing ) succResizing :: (KnownNat n) => Index n -> Index (n+1) succResizing n = (resize n) + 1 sendData dfDatIn dataAck = do (burstLenLeft, readId) <- get - case (burstLenLeft, dfDatIn) of - (0, Just (_rdata, _ruser, _rresp)) -> do + case (burstLenLeft == 0, dfDatIn) of + (False, Just (_rdata, _ruser, _rresp)) -> do put (burstLenLeft-1, readId) P.pure ( S2M_ReadData diff --git a/tests/Tests/Protocols.hs b/tests/Tests/Protocols.hs index cb61f409..b1b3914a 100644 --- a/tests/Tests/Protocols.hs +++ b/tests/Tests/Protocols.hs @@ -3,14 +3,16 @@ module Tests.Protocols (tests, main) where import Test.Tasty import qualified Tests.Protocols.Df import qualified Tests.Protocols.DfConv -import qualified Tests.Protocols.AvalonMemMap +import qualified Tests.Protocols.Avalon +import qualified Tests.Protocols.Axi4 import qualified Tests.Protocols.Wishbone tests :: TestTree tests = testGroup "Protocols" [ Tests.Protocols.Df.tests , Tests.Protocols.DfConv.tests - , Tests.Protocols.AvalonMemMap.tests + , Tests.Protocols.Avalon.tests + , Tests.Protocols.Axi4.tests , Tests.Protocols.Wishbone.tests ] diff --git a/tests/Tests/Protocols/AvalonMemMap.hs b/tests/Tests/Protocols/Avalon.hs similarity index 85% rename from tests/Tests/Protocols/AvalonMemMap.hs rename to tests/Tests/Protocols/Avalon.hs index 040e03f4..1973985f 100644 --- a/tests/Tests/Protocols/AvalonMemMap.hs +++ b/tests/Tests/Protocols/Avalon.hs @@ -2,7 +2,7 @@ {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE RecordWildCards #-} -module Tests.Protocols.AvalonMemMap where +module Tests.Protocols.Avalon where -- base import Prelude @@ -30,8 +30,10 @@ import qualified Protocols.Df as Df import Protocols.Hedgehog import qualified Protocols.DfConv as DfConv import Protocols.Avalon.MemMap +import Protocols.Avalon.Stream -- tests +import Util import qualified Tests.Protocols.Df as DfTest --------------------------------------------------------------- @@ -150,6 +152,33 @@ prop_avalon_convert_subordinate_manager_rev = (AvalonMmManager dom ManagerConfig) ckt = DfConv.convert Proxy Proxy +-- also test out the DfConv instance for AvalonStream + +prop_avalon_stream_fifo_id :: Property +prop_avalon_stream_fifo_id = + propWithModelSingleDomain + @C.System + defExpectOptions + (DfTest.genData genInfo) + (C.exposeClockResetEnable id) + (C.exposeClockResetEnable @C.System ckt) + (\a b -> tally a === tally b) + where + ckt :: (C.HiddenClockResetEnable dom) => + Circuit + (AvalonStream dom ('AvalonStreamConfig 2 2 'True 'True 2 0) Int) + (AvalonStream dom ('AvalonStreamConfig 2 2 'True 'True 2 0) Int) + ckt = DfConv.fifo Proxy Proxy (C.SNat @10) + + genInfo = + AvalonStreamM2S <$> + DfTest.genSmallInt <*> + Gen.enumBounded <*> + Gen.enumBounded <*> + (toKeepType <$> Gen.enumBounded) <*> + (toKeepType <$> Gen.enumBounded) <*> + Gen.enumBounded + tests :: TestTree tests = diff --git a/tests/Tests/Protocols/Axi4.hs b/tests/Tests/Protocols/Axi4.hs new file mode 100644 index 00000000..2c61fe4f --- /dev/null +++ b/tests/Tests/Protocols/Axi4.hs @@ -0,0 +1,303 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE RecordWildCards #-} + +module Tests.Protocols.Axi4 where + +-- base +import Prelude + +-- clash-prelude +import qualified Clash.Prelude as C + +-- extra +import Data.Proxy (Proxy(..)) + +-- hedgehog +import Hedgehog +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range + +-- strict-tuple +import Data.Tuple.Strict (T3(..), T4(..)) + +-- tasty +import Test.Tasty +import Test.Tasty.Hedgehog (HedgehogTestLimit(HedgehogTestLimit)) +import Test.Tasty.Hedgehog.Extra (testProperty) +import Test.Tasty.TH (testGroupGenerator) + +-- clash-protocols (me!) +import Protocols +import Protocols.Internal +import qualified Protocols.Df as Df +import Protocols.Hedgehog +import qualified Protocols.DfConv as DfConv +import Protocols.Axi4.Common +import Protocols.Axi4.WriteAddress +import Protocols.Axi4.WriteData +import Protocols.Axi4.WriteResponse +import Protocols.Axi4.ReadAddress +import Protocols.Axi4.ReadData +import Protocols.Axi4.Stream + +-- tests +import Util +import qualified Tests.Protocols.Df as DfTest + +--------------------------------------------------------------- +---------------------------- TESTS ---------------------------- +--------------------------------------------------------------- + +type ConfAW = + 'Axi4WriteAddressConfig 'True 'True 2 2 'True 'True 'True 'True 'True 'True +type ConfW = 'Axi4WriteDataConfig 'True 2 +type ConfB = 'Axi4WriteResponseConfig 'True 2 +type ConfAR = + 'Axi4ReadAddressConfig 'True 'True 2 2 'True 'True 'True 'True 'True 'True +type ConfR = 'Axi4ReadDataConfig 'True 2 + +prop_axi4_convert_write_id :: Property +prop_axi4_convert_write_id = + DfTest.idWithModelDf + defExpectOptions + (DfTest.genData genInfo) + id + ( C.withClockResetEnable @C.System C.clockGen C.resetGen C.enableGen + $ DfConv.dfConvTestBench Proxy Proxy + (repeat True) (repeat $ Df.Data (toKeepType ROkay, 0)) ckt) + where + ckt :: (C.HiddenClockResetEnable dom) => + Circuit + (Axi4WriteAddress dom ConfAW Int, + Axi4WriteData dom ConfW Int, + Reverse (Axi4WriteResponse dom ConfB Int)) + (Axi4WriteAddress dom ConfAW Int, + Axi4WriteData dom ConfW Int, + Reverse (Axi4WriteResponse dom ConfB Int)) + ckt = DfConv.convert Proxy Proxy + + genInfo = (,,,,) + <$> genWriteAddrInfo + <*> genBurstLen + <*> genBurst + <*> genStrobe + <*> DfTest.genSmallInt + genWriteAddrInfo + = Axi4WriteAddressInfo + <$> Gen.enumBounded + <*> Gen.enumBounded + <*> (toKeepType <$> Gen.enumBounded) + <*> (toKeepType <$> + (pure Bs1 C.<|> + pure Bs2 C.<|> + pure Bs4 C.<|> + pure Bs8 C.<|> + pure Bs16 C.<|> + pure Bs32 C.<|> + pure Bs64 C.<|> + pure Bs128)) + <*> (toKeepType <$> (pure NonExclusiveAccess C.<|> pure ExclusiveAccess)) + <*> ( toKeepType <$> ( T4 + <$> (pure NonBufferable C.<|> pure Bufferable) + <*> (pure NonModifiable C.<|> pure Modifiable) + <*> (pure OtherNoLookupCache C.<|> pure OtherLookupCache) + <*> (pure NoLookupCache C.<|> pure LookupCache) ) ) + <*> ( toKeepType <$> ( T3 + <$> (pure Privileged C.<|> pure NotPrivileged) + <*> (pure Secure C.<|> pure NonSecure) + <*> (pure Instruction C.<|> pure Data) ) ) + <*> (toKeepType <$> Gen.enumBounded) + <*> DfTest.genSmallInt + + genBurstLen = toKeepType <$> pure 0 + genBurst = toKeepType <$> (pure BmFixed C.<|> pure BmIncr C.<|> pure BmWrap) + genStrobe = genVec $ pure Nothing C.<|> (Just <$> Gen.enumBounded) + +prop_axi4_convert_write_id_rev :: Property +prop_axi4_convert_write_id_rev = + DfTest.idWithModelDf + defExpectOptions + (DfTest.genData genInfo) + id + ( C.withClockResetEnable @C.System C.clockGen C.resetGen C.enableGen + $ DfConv.dfConvTestBenchRev Proxy Proxy + (repeat $ Df.Data fwdInfo) (repeat True) ckt) + where + ckt :: (C.HiddenClockResetEnable dom) => + Circuit + (Axi4WriteAddress dom ConfAW Int, + Axi4WriteData dom ConfW Int, + Reverse (Axi4WriteResponse dom ConfB Int)) + (Axi4WriteAddress dom ConfAW Int, + Axi4WriteData dom ConfW Int, + Reverse (Axi4WriteResponse dom ConfB Int)) + ckt = DfConv.convert Proxy Proxy + + genInfo = (,) <$> genResp <*> DfTest.genSmallInt + genResp = toKeepType <$> + ( pure ROkay C.<|> + pure RExclusiveOkay C.<|> + pure RSlaveError C.<|> + pure RDecodeError ) + + fwdInfo + = (Axi4WriteAddressInfo + { _awiid = 0 + , _awiaddr = 0 + , _awiregion = toKeepType 0 + , _awisize = toKeepType Bs1 + , _awilock = toKeepType NonExclusiveAccess + , _awicache + = toKeepType (T4 + NonBufferable + NonModifiable + OtherNoLookupCache + NoLookupCache ) + , _awiprot + = toKeepType (T3 + Privileged + Secure + Instruction ) + , _awiqos = toKeepType 0 + , _awiuser = 0 + }, toKeepType 0, toKeepType BmFixed, C.repeat Nothing, 0 ) + +prop_axi4_convert_read_id :: Property +prop_axi4_convert_read_id = + DfTest.idWithModelDf + defExpectOptions + (DfTest.genData genInfo) + id + ( C.withClockResetEnable @C.System C.clockGen C.resetGen C.enableGen + $ DfConv.dfConvTestBench Proxy Proxy + (repeat True) (repeat $ Df.Data (0, 0, toKeepType ROkay)) ckt) + where + ckt :: (C.HiddenClockResetEnable dom) => + Circuit + (Axi4ReadAddress dom ConfAR Int, + Reverse (Axi4ReadData dom ConfR Int Int)) + (Axi4ReadAddress dom ConfAR Int, + Reverse (Axi4ReadData dom ConfR Int Int)) + ckt = DfConv.convert Proxy Proxy + + genInfo + = Axi4ReadAddressInfo + <$> Gen.enumBounded + <*> Gen.enumBounded + <*> (toKeepType <$> Gen.enumBounded) + <*> (Gen.integral (Range.linear 0 10)) + <*> (toKeepType <$> + (pure Bs1 C.<|> + pure Bs2 C.<|> + pure Bs4 C.<|> + pure Bs8 C.<|> + pure Bs16 C.<|> + pure Bs32 C.<|> + pure Bs64 C.<|> + pure Bs128)) + <*> (toKeepType <$> (pure BmFixed C.<|> pure BmIncr C.<|> pure BmWrap)) + <*> (toKeepType <$> (pure NonExclusiveAccess C.<|> pure ExclusiveAccess)) + <*> ( toKeepType <$> ( T4 + <$> (pure NonBufferable C.<|> pure Bufferable) + <*> (pure NonModifiable C.<|> pure Modifiable) + <*> (pure OtherNoLookupCache C.<|> pure OtherLookupCache) + <*> (pure NoLookupCache C.<|> pure LookupCache) ) ) + <*> ( toKeepType <$> ( T3 + <$> (pure Privileged C.<|> pure NotPrivileged) + <*> (pure Secure C.<|> pure NonSecure) + <*> (pure Instruction C.<|> pure Data) ) ) + <*> (toKeepType <$> Gen.enumBounded) + <*> DfTest.genSmallInt + +prop_axi4_convert_read_id_rev :: Property +prop_axi4_convert_read_id_rev = + DfTest.idWithModelDf + defExpectOptions + (DfTest.genData genInfo) + id + ( C.withClockResetEnable @C.System C.clockGen C.resetGen C.enableGen + $ DfConv.dfConvTestBenchRev Proxy Proxy + (repeat $ Df.Data fwdInfo) (repeat True) ckt) + where + ckt :: (C.HiddenClockResetEnable dom) => + Circuit + (Axi4ReadAddress dom ConfAR Int, + Reverse (Axi4ReadData dom ConfR Int Int)) + (Axi4ReadAddress dom ConfAR Int, + Reverse (Axi4ReadData dom ConfR Int Int)) + ckt = DfConv.convert Proxy Proxy + + genInfo + = (,,) + <$> DfTest.genSmallInt + <*> DfTest.genSmallInt + <*> (toKeepType + <$> (pure ROkay + C.<|> pure RExclusiveOkay + C.<|> pure RSlaveError + C.<|> pure RDecodeError)) + + fwdInfo + = Axi4ReadAddressInfo + { _ariid = 0 + , _ariaddr = 0 + , _ariregion = toKeepType 0 + , _arilen = toKeepType 0 + , _arisize = toKeepType Bs1 + , _ariburst = toKeepType BmFixed + , _arilock = toKeepType NonExclusiveAccess + , _aricache + = toKeepType (T4 + NonBufferable + NonModifiable + OtherNoLookupCache + NoLookupCache ) + , _ariprot + = toKeepType (T3 + Privileged + Secure + Instruction ) + , _ariqos = toKeepType 0 + , _ariuser = 0 + } + +-- also test out the DfConv instance for Axi4Stream + +prop_axi4_stream_fifo_id :: Property +prop_axi4_stream_fifo_id = + propWithModelSingleDomain + @C.System + defExpectOptions + (DfTest.genData genInfo) + (C.exposeClockResetEnable id) + (C.exposeClockResetEnable @C.System ckt) + (\a b -> tally a === tally b) + where + ckt :: (C.HiddenClockResetEnable dom) => + Circuit + (Axi4Stream dom ('Axi4StreamConfig 5 2 2) Int) + (Axi4Stream dom ('Axi4StreamConfig 5 2 2) Int) + ckt = DfConv.fifo Proxy Proxy (C.SNat @10) + + genInfo = + Axi4StreamM2S <$> + (genVec Gen.enumBounded) <*> + (genVec Gen.enumBounded) <*> + (genVec Gen.enumBounded) <*> + Gen.enumBounded <*> + Gen.enumBounded <*> + Gen.enumBounded <*> + DfTest.genSmallInt + + +tests :: TestTree +tests = + -- TODO: Move timeout option to hedgehog for better error messages. + -- TODO: Does not seem to work for combinatorial loops like @let x = x in x@?? + localOption (mkTimeout 12_000_000 {- 12 seconds -}) + $ localOption (HedgehogTestLimit (Just 1000)) + $(testGroupGenerator) + +main :: IO () +main = defaultMain tests diff --git a/tests/Tests/Protocols/DfConv.hs b/tests/Tests/Protocols/DfConv.hs index d8c70d74..cdd46e61 100644 --- a/tests/Tests/Protocols/DfConv.hs +++ b/tests/Tests/Protocols/DfConv.hs @@ -31,8 +31,6 @@ import Test.Tasty.TH (testGroupGenerator) -- clash-protocols (me!) import Protocols -import Protocols.Avalon.Stream -import Protocols.Axi4.Stream import Protocols.Hedgehog import Protocols.Internal import qualified Protocols.Df as Df @@ -176,6 +174,19 @@ prop_select = dats <- mapM (\i -> Gen.list (Range.singleton (tall i)) DfTest.genSmallInt) C.indicesI pure (dats, ixs) +-- test out instance DfConv (Reverse a) + +prop_reverse_df_convert_id :: Property +prop_reverse_df_convert_id = + DfTest.idWithModelDf' + id + (C.withClockResetEnable C.clockGen C.resetGen C.enableGen ckt) + where + ckt :: (C.HiddenClockResetEnable dom) => Circuit (Df dom Int) (Df dom Int) + ckt = coerceCircuit + $ reverseCircuit + $ DfConv.convert (Proxy @(Reverse (Df _ _))) (Proxy @(Reverse (Df _ _))) + -- test out the test bench prop_test_bench_id :: Property prop_test_bench_id = @@ -209,61 +220,6 @@ prop_test_bench_rev_id = (Df dom Int, Reverse (Df dom Int)) ckt = DfConv.convert Proxy Proxy --- also test out the DfConv instance for AvalonStream - -prop_avalon_stream_fifo_id :: Property -prop_avalon_stream_fifo_id = - propWithModelSingleDomain - @C.System - defExpectOptions - (DfTest.genData genInfo) - (C.exposeClockResetEnable id) - (C.exposeClockResetEnable @C.System ckt) - (\a b -> tally a === tally b) - where - ckt :: (C.HiddenClockResetEnable dom) => - Circuit - (AvalonStream dom ('AvalonStreamConfig 2 2 'True 'True 2 0) Int) - (AvalonStream dom ('AvalonStreamConfig 2 2 'True 'True 2 0) Int) - ckt = DfConv.fifo Proxy Proxy (C.SNat @10) - - genInfo = - AvalonStreamM2S <$> - DfTest.genSmallInt <*> - Gen.enumBounded <*> - Gen.enumBounded <*> - (toKeepType <$> Gen.enumBounded) <*> - (toKeepType <$> Gen.enumBounded) <*> - Gen.enumBounded - --- also test out the DfConv instance for Axi4Stream - -prop_axi4_stream_fifo_id :: Property -prop_axi4_stream_fifo_id = - propWithModelSingleDomain - @C.System - defExpectOptions - (DfTest.genData genInfo) - (C.exposeClockResetEnable id) - (C.exposeClockResetEnable @C.System ckt) - (\a b -> tally a === tally b) - where - ckt :: (C.HiddenClockResetEnable dom) => - Circuit - (Axi4Stream dom ('Axi4StreamConfig 5 2 2) Int) - (Axi4Stream dom ('Axi4StreamConfig 5 2 2) Int) - ckt = DfConv.fifo Proxy Proxy (C.SNat @10) - - genInfo = - Axi4StreamM2S <$> - (genVec Gen.enumBounded) <*> - (genVec Gen.enumBounded) <*> - (genVec Gen.enumBounded) <*> - Gen.enumBounded <*> - Gen.enumBounded <*> - Gen.enumBounded <*> - DfTest.genSmallInt - tests :: TestTree tests =