Tuple kinds, categories and arrows

clash-protocols.cabal

@@ -211,7 +211,7 @@ test-suite unittests
     Tests.Protocols.DfConv
     Tests.Protocols.Avalon
     Tests.Protocols.Axi4
-    Tests.Protocols.Plugin
+--    Tests.Protocols.Plugin
     Tests.Protocols.Wishbone
 
     Util

src/Protocols.hs

@@ -13,9 +13,15 @@ definitions in @circuit-notation@ at <https://github.com/cchalmers/circuit-notat
 module Protocols
   ( -- * Circuit definition
     Circuit(Circuit)
-  , Protocol(Fwd, Bwd)
+  , Fwd
+  , Bwd
   , Backpressure(boolsToBwd)
   , Ack(..)
+  , NC
+  , I2
+  , I3
+  , IVec
+  , type (><)
 
     -- * Combinators & functions
   , (|>), (<|)

src/Protocols/Avalon/MemMap.hs

@@ -85,8 +85,8 @@ module Protocols.Avalon.MemMap
   , subordinateInRemoveNonDf
 
     -- * Protocols
-  , AvalonMmManager(..)
-  , AvalonMmSubordinate(..)
+  , AvalonMmManager
+  , AvalonMmSubordinate
   ) where
 
 -- base
@@ -1001,25 +1001,17 @@ mmManagerInToBool ::
 mmManagerInToBool = not . mi_waitRequest
 
 -- | Datatype for the manager end of the Avalon memory-mapped protocol.
-data AvalonMmManager (dom :: Domain) (config :: AvalonMmManagerConfig)
-  = AvalonMmManager
+type AvalonMmManager (dom :: Domain) (config :: AvalonMmManagerConfig)
+  =  (Signal dom (AvalonManagerOut config))
+  >< (Signal dom (AvalonManagerIn config))
 
 -- | Datatype for the subordinate end of the Avalon memory-mapped protocol.
-data AvalonMmSubordinate
+type AvalonMmSubordinate
        (dom :: Domain)
        (fixedWaitTime :: Nat)
        (config :: AvalonMmSubordinateConfig)
-       = AvalonMmSubordinate
-
-instance Protocol (AvalonMmManager dom config) where
-  type Fwd (AvalonMmManager dom config) = Signal dom (AvalonManagerOut config)
-  type Bwd (AvalonMmManager dom config) = Signal dom (AvalonManagerIn config)
-
-instance Protocol (AvalonMmSubordinate dom fixedWaitTime config) where
-  type Fwd (AvalonMmSubordinate dom fixedWaitTime config)
-         = Signal dom (AvalonSubordinateIn config)
-  type Bwd (AvalonMmSubordinate dom fixedWaitTime config)
-         = Signal dom (AvalonSubordinateOut config)
+  =  (Signal dom (AvalonSubordinateIn config))
+  >< (Signal dom (AvalonSubordinateOut config))
 
 instance (KnownSubordinateConfig config, KeepWaitRequest config ~ 'True) =>
   Backpressure (AvalonMmSubordinate dom 0 config) where

src/Protocols/Avalon/Stream.hs

@@ -4,6 +4,7 @@ Types and instance declarations for the Avalon-stream protocol.
 
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE MagicHash #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE RecordWildCards #-}
@@ -136,22 +137,28 @@ newtype AvalonStreamS2M (readyLatency :: Nat) = AvalonStreamS2M { _ready :: Bool
   deriving (Generic, C.NFDataX, C.ShowX, Eq, NFData, Show, Bundle)
 
 -- | Type for Avalon Stream protocol.
-data AvalonStream (dom :: Domain) (conf :: AvalonStreamConfig) (dataType :: Type)
+type AvalonStream (dom :: Domain) (conf :: AvalonStreamConfig) (dataType :: Type)
+  = AvalonStream# dom conf dataType (ReadyLatency conf)
 
-instance Protocol (AvalonStream dom conf dataType) where
-  type Fwd (AvalonStream dom conf dataType)
-    = Signal dom (Maybe (AvalonStreamM2S conf dataType))
-  type Bwd (AvalonStream dom conf dataType)
-    = Signal dom (AvalonStreamS2M (ReadyLatency conf))
+type AvalonStream#
+  (dom :: Domain)
+  (conf :: AvalonStreamConfig)
+  (dataType :: Type)
+  (n :: Nat)
+  =  (Signal dom (Maybe (AvalonStreamM2S conf dataType)))
+  >< (Signal dom (AvalonStreamS2M n))
 
 instance (ReadyLatency conf ~ 0) =>
-  Backpressure (AvalonStream dom conf dataType) where
+  Backpressure (AvalonStream# dom conf dataType 0) where
   boolsToBwd _ = C.fromList_lazy . fmap AvalonStreamS2M
 
-instance (KnownAvalonStreamConfig conf, NFDataX dataType) =>
-  DfConv.DfConv    (AvalonStream dom conf dataType) where
-  type Dom         (AvalonStream dom conf dataType) = dom
-  type FwdPayload  (AvalonStream dom conf dataType)
+instance
+  ( ReadyLatency conf ~ n
+  , KnownAvalonStreamConfig conf
+  , NFDataX dataType ) =>
+  DfConv.DfConv    (AvalonStream# dom conf dataType n) where
+  type Dom         (AvalonStream# dom conf dataType n) = dom
+  type FwdPayload  (AvalonStream# dom conf dataType n)
     = AvalonStreamM2S conf dataType
 
   toDfCircuit proxy = DfConv.toDfCircuitHelper proxy s0 blankOtp stateFn where
@@ -181,11 +188,11 @@ instance
   , KnownAvalonStreamConfig conf
   , NFDataX dataType
   , KnownDomain dom ) =>
-  Simulate (AvalonStream dom conf dataType) where
-  type SimulateFwdType (AvalonStream dom conf dataType)
+  Simulate (AvalonStream# dom conf dataType 0) where
+  type SimulateFwdType (AvalonStream# dom conf dataType 0)
     = [Maybe (AvalonStreamM2S conf dataType)]
-  type SimulateBwdType (AvalonStream dom conf dataType) = [AvalonStreamS2M 0]
-  type SimulateChannels (AvalonStream dom conf dataType) = 1
+  type SimulateBwdType (AvalonStream# dom conf dataType 0) = [AvalonStreamS2M 0]
+  type SimulateChannels (AvalonStream# dom conf dataType 0) = 1
 
   simToSigFwd _ = fromList_lazy
   simToSigBwd _ = fromList_lazy
@@ -201,8 +208,8 @@ instance
   , KnownAvalonStreamConfig conf
   , NFDataX dataType
   , KnownDomain dom ) =>
-  Drivable (AvalonStream dom conf dataType) where
-  type ExpectType (AvalonStream dom conf dataType)
+  Drivable (AvalonStream# dom conf dataType 0) where
+  type ExpectType (AvalonStream# dom conf dataType 0)
     = [AvalonStreamM2S conf dataType]
 
   toSimulateType Proxy = P.map Just
@@ -225,7 +232,7 @@ instance
   , Show dataType
   , Eq dataType
   , KnownDomain dom ) =>
-  Test (AvalonStream dom conf dataType) where
+  Test (AvalonStream# dom conf dataType 0) where
 
   expectToLengths Proxy = pure . P.length
   expectN Proxy options nExpected sampled

src/Protocols/Axi4/ReadAddress.hs

@@ -124,16 +124,12 @@ type family ARKeepQos (conf :: Axi4ReadAddressConfig) where
   ARKeepQos ('Axi4ReadAddressConfig _ _ _ _ _ _ _ _ _ a) = a
 
 -- | AXI4 Read Address channel protocol
-data Axi4ReadAddress
+type Axi4ReadAddress
   (dom :: C.Domain)
   (conf :: Axi4ReadAddressConfig)
   (userType :: Type)
-
-instance Protocol (Axi4ReadAddress dom conf userType) where
-  type Fwd (Axi4ReadAddress dom conf userType) =
-    C.Signal dom (M2S_ReadAddress conf userType)
-  type Bwd (Axi4ReadAddress dom conf userType) =
-    C.Signal dom S2M_ReadAddress
+  =  C.Signal dom (M2S_ReadAddress conf userType)
+  >< C.Signal dom S2M_ReadAddress
 
 instance Backpressure (Axi4ReadAddress dom conf userType) where
   boolsToBwd _ = C.fromList_lazy . coerce

src/Protocols/Axi4/ReadData.hs

@@ -55,17 +55,13 @@ type family RIdWidth (conf :: Axi4ReadDataConfig) where
   RIdWidth ('Axi4ReadDataConfig _ a) = a
 
 -- | AXI4 Read Data channel protocol
-data Axi4ReadData
+type Axi4ReadData
   (dom :: C.Domain)
   (conf :: Axi4ReadDataConfig)
   (userType :: Type)
   (dataType :: Type)
-
-instance Protocol (Axi4ReadData dom conf userType dataType) where
-  type Fwd (Axi4ReadData dom conf userType dataType) =
-    C.Signal dom (S2M_ReadData conf userType dataType)
-  type Bwd (Axi4ReadData dom conf userType dataType) =
-    C.Signal dom M2S_ReadData
+  =  C.Signal dom (S2M_ReadData conf userType dataType)
+  >< C.Signal dom M2S_ReadData
 
 instance Backpressure (Axi4ReadData dom conf userType dataType) where
   boolsToBwd _ = C.fromList_lazy . coerce

src/Protocols/Axi4/Stream.hs

@@ -101,11 +101,9 @@ newtype Axi4StreamS2M = Axi4StreamS2M { _tready :: Bool }
   deriving (Generic, C.NFDataX, C.ShowX, Eq, NFData, Show, Bundle)
 
 -- | Type for AXI4 Stream protocol.
-data Axi4Stream (dom :: Domain) (conf :: Axi4StreamConfig) (userType :: Type)
-
-instance Protocol (Axi4Stream dom conf userType) where
-  type Fwd (Axi4Stream dom conf userType) = Signal dom (Maybe (Axi4StreamM2S conf userType))
-  type Bwd (Axi4Stream dom conf userType) = Signal dom Axi4StreamS2M
+type Axi4Stream (dom :: Domain) (conf :: Axi4StreamConfig) (userType :: Type)
+  =  Signal dom (Maybe (Axi4StreamM2S conf userType))
+  >< Signal dom Axi4StreamS2M
 
 instance Backpressure (Axi4Stream dom conf userType) where
   boolsToBwd _ = C.fromList_lazy . fmap Axi4StreamS2M

src/Protocols/Axi4/WriteAddress.hs

@@ -124,16 +124,12 @@ type family AWKeepQos (c :: Axi4WriteAddressConfig) where
   AWKeepQos ('Axi4WriteAddressConfig _ _ _ _ _ _ _ _ _ a) = a
 
 -- | AXI4 Write Address channel protocol
-data Axi4WriteAddress
+type Axi4WriteAddress
   (dom :: C.Domain)
   (conf :: Axi4WriteAddressConfig)
   (userType :: Type)
-
-instance Protocol (Axi4WriteAddress dom conf userType) where
-  type Fwd (Axi4WriteAddress dom conf userType) =
-    C.Signal dom (M2S_WriteAddress conf userType)
-  type Bwd (Axi4WriteAddress dom conf userType) =
-    C.Signal dom S2M_WriteAddress
+  =  C.Signal dom (M2S_WriteAddress conf userType)
+  >< C.Signal dom S2M_WriteAddress
 
 instance Backpressure (Axi4WriteAddress dom conf userType) where
   boolsToBwd _ = C.fromList_lazy . coerce

src/Protocols/Axi4/WriteData.hs

@@ -55,16 +55,12 @@ type family WNBytes (conf :: Axi4WriteDataConfig) where
   WNBytes ('Axi4WriteDataConfig _ a) = a
 
 -- | AXI4 Write Data channel protocol
-data Axi4WriteData
+type Axi4WriteData
   (dom :: C.Domain)
   (conf :: Axi4WriteDataConfig)
   (userType :: Type)
-
-instance Protocol (Axi4WriteData dom conf userType) where
-  type Fwd (Axi4WriteData dom conf userType) =
-    C.Signal dom (M2S_WriteData conf userType)
-  type Bwd (Axi4WriteData dom conf userType) =
-    C.Signal dom S2M_WriteData
+  =  C.Signal dom (M2S_WriteData conf userType)
+  >< C.Signal dom S2M_WriteData
 
 instance Backpressure (Axi4WriteData dom conf userType) where
   boolsToBwd _ = C.fromList_lazy . coerce

src/Protocols/Axi4/WriteResponse.hs

@@ -53,16 +53,12 @@ type family BIdWidth (conf :: Axi4WriteResponseConfig) where
   BIdWidth ('Axi4WriteResponseConfig _ a) = a
 
 -- | AXI4 Read Data channel protocol
-data Axi4WriteResponse
+type Axi4WriteResponse
   (dom :: C.Domain)
   (conf :: Axi4WriteResponseConfig)
   (userType :: Type)
-
-instance Protocol (Axi4WriteResponse dom conf userType) where
-  type Fwd (Axi4WriteResponse dom conf userType) =
-    C.Signal dom (S2M_WriteResponse conf userType)
-  type Bwd (Axi4WriteResponse dom conf userType) =
-    C.Signal dom M2S_WriteResponse
+  =  C.Signal dom (S2M_WriteResponse conf userType)
+  >< C.Signal dom M2S_WriteResponse
 
 instance Backpressure (Axi4WriteResponse dom conf userType) where
   boolsToBwd _ = C.fromList_lazy . coerce