Move BackPressure and Simulate to Protocols.Internal.Classes

clash-protocols-base/src/Protocols/Plugin/Types.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE RoleAnnotations #-}
 {-# OPTIONS_HADDOCK hide #-}
 

clash-protocols/clash-protocols.cabal

@@ -149,6 +149,7 @@ library
     Protocols.DfConv
     Protocols.Hedgehog
     Protocols.Hedgehog.Internal
+    Protocols.Hedgehog.Types
     Protocols.Idle
     Protocols.Internal.TH
     Protocols.Wishbone

clash-protocols/src/Protocols/Avalon/Stream.hs

@@ -29,7 +29,7 @@ import qualified Clash.Prelude as C
 
 import qualified Protocols.Df as Df
 import qualified Protocols.DfConv as DfConv
-import Protocols.Hedgehog.Internal
+import Protocols.Hedgehog
 import Protocols.Idle
 import Protocols.Internal
 

clash-protocols/src/Protocols/Axi4/Stream.hs

@@ -26,7 +26,7 @@ import qualified Clash.Prelude as C
 
 import qualified Protocols.Df as Df
 import qualified Protocols.DfConv as DfConv
-import Protocols.Hedgehog.Internal
+import Protocols.Hedgehog
 import Protocols.Idle
 import Protocols.Internal
 

clash-protocols/src/Protocols/Hedgehog.hs

@@ -55,6 +55,9 @@ import qualified Hedgehog.Range as Range
 -- lifted-async
 import Control.Concurrent.Async.Lifted (race)
 
+-- me
+import Protocols.Hedgehog.Types
+
 -- | Whether to stall or not. Used in 'idWithModel'.
 data StallMode = NoStall | Stall
   deriving (Show, Enum, Bounded)

clash-protocols/src/Protocols/Hedgehog/Internal.hs

@@ -3,6 +3,7 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE UndecidableSuperClasses #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# OPTIONS_HADDOCK hide #-}
 
 {- |
@@ -20,37 +21,15 @@ import Protocols
 import qualified Protocols.Df as Df
 
 -- clash-prelude
-
 import Clash.Prelude (type (*), type (+), type (<=))
 import qualified Clash.Prelude as C
 
--- deepseq
-import Control.DeepSeq
-
 -- hedgehog
 import qualified Hedgehog as H
 import qualified Hedgehog.Internal.Property as H
 
--- | Options for 'expectN' function. See individual fields for more information.
-data ExpectOptions = ExpectOptions
-  { eoStopAfterEmpty :: Int
-  -- ^ Stop sampling after seeing /n/ consecutive empty samples
-  , eoSampleMax :: Int
-  -- ^ Produce an error if the circuit produces more than /n/ valid samples. This
-  -- is used to terminate (potentially) infinitely running circuits.
-  --
-  -- This number is used to generate stall information, so setting it to
-  -- unreasonable values will result in long runtimes.
-  , eoResetCycles :: Int
-  -- ^ Ignore first /n/ cycles
-  , eoDriveEarly :: Bool
-  -- ^ Start driving the circuit with its reset asserted. Circuits should
-  -- never acknowledge data while this is happening.
-  , eoTimeoutMs :: Maybe Int
-  -- ^ Terminate the test after /n/ milliseconds.
-  , eoTrace :: Bool
-  -- ^ Trace data generation for debugging purposes
-  }
+-- me
+import Protocols.Hedgehog.Types
 
 {- | Resets for 30 cycles, checks for superfluous data for 50 cycles after
 seeing last valid data cycle, and times out after seeing 1000 consecutive
@@ -72,45 +51,6 @@ defExpectOptions =
     , eoTrace = False
     }
 
--- | Superclass class to reduce syntactical noise.
-class (NFData a, C.NFDataX a, C.ShowX a, C.Show a, Eq a) => TestType a
-
-instance (NFData a, C.NFDataX a, C.ShowX a, C.Show a, Eq a) => TestType a
-
-{- | Provides a way of comparing expected data with data produced by a
-protocol component.
--}
-class
-  ( Drivable a
-  , TestType (SimulateFwdType a)
-  , TestType (ExpectType a)
-  , -- Foldable requirement on Vec :(
-    1 <= SimulateChannels a
-  ) =>
-  Test a
-  where
-  -- | Trim each channel to the lengths given as the third argument. See
-  -- result documentation for failure modes.
-  expectN ::
-    (HasCallStack, H.MonadTest m) =>
-    Proxy a ->
-    -- | Options, see 'ExpectOptions'
-    ExpectOptions ->
-    -- | Raw sampled data
-    SimulateFwdType a ->
-    -- | Depending on "ExpectOptions", fails the test if:
-    --
-    --   * Circuit produced less data than expected
-    --   * Circuit produced more data than expected
-    --
-    -- If it does not fail, /SimulateFwdType a/ will contain exactly the number
-    -- of expected data packets.
-    --
-    -- TODO:
-    --   Should probably return a 'Vec (SimulateChannels) Failures'
-    --   in order to produce pretty reports.
-    m (ExpectType a)
-
 instance (TestType a, C.KnownDomain dom) => Test (Df dom a) where
   expectN ::
     forall m.

clash-protocols/src/Protocols/Hedgehog/Types.hs

@@ -0,0 +1,77 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE UndecidableSuperClasses #-}
+
+module Protocols.Hedgehog.Types where
+
+-- deepseq
+import Control.DeepSeq
+
+import qualified Clash.Prelude as C
+import Data.Proxy
+import GHC.Stack (HasCallStack)
+import Protocols.Internal.Types
+
+-- hedgehog
+import qualified Hedgehog as H
+
+-- | Superclass class to reduce syntactical noise.
+class (NFData a, C.NFDataX a, C.ShowX a, C.Show a, Eq a) => TestType a
+
+instance (NFData a, C.NFDataX a, C.ShowX a, C.Show a, Eq a) => TestType a
+
+-- | Options for 'expectN' function. See individual fields for more information.
+data ExpectOptions = ExpectOptions
+  { eoStopAfterEmpty :: Int
+  -- ^ Stop sampling after seeing /n/ consecutive empty samples
+  , eoSampleMax :: Int
+  -- ^ Produce an error if the circuit produces more than /n/ valid samples. This
+  -- is used to terminate (potentially) infinitely running circuits.
+  --
+  -- This number is used to generate stall information, so setting it to
+  -- unreasonable values will result in long runtimes.
+  , eoResetCycles :: Int
+  -- ^ Ignore first /n/ cycles
+  , eoDriveEarly :: Bool
+  -- ^ Start driving the circuit with its reset asserted. Circuits should
+  -- never acknowledge data while this is happening.
+  , eoTimeoutMs :: Maybe Int
+  -- ^ Terminate the test after /n/ milliseconds.
+  , eoTrace :: Bool
+  -- ^ Trace data generation for debugging purposes
+  }
+
+{- | Provides a way of comparing expected data with data produced by a
+protocol component.
+-}
+class
+  ( Drivable a
+  , TestType (SimulateFwdType a)
+  , TestType (ExpectType a)
+  , -- Foldable requirement on Vec :(
+    1 C.<= SimulateChannels a
+  ) =>
+  Test a
+  where
+  -- | Trim each channel to the lengths given as the third argument. See
+  -- result documentation for failure modes.
+  expectN ::
+    (HasCallStack, H.MonadTest m) =>
+    Proxy a ->
+    -- | Options, see 'ExpectOptions'
+    ExpectOptions ->
+    -- | Raw sampled data
+    SimulateFwdType a ->
+    -- | Depending on "ExpectOptions", fails the test if:
+    --
+    --   * Circuit produced less data than expected
+    --   * Circuit produced more data than expected
+    --
+    -- If it does not fail, /SimulateFwdType a/ will contain exactly the number
+    -- of expected data packets.
+    --
+    -- TODO:
+    --   Should probably return a 'Vec (SimulateChannels) Failures'
+    --   in order to produce pretty reports.
+    m (ExpectType a)

clash-protocols/src/Protocols/Internal.hs

@@ -88,12 +88,6 @@ infixr 1 |>
    in
     (r2sAb, s2rBc)
 
--- | Conversion from booleans to protocol specific acknowledgement values.
-class (Protocol a) => Backpressure a where
-  -- | Interpret list of booleans as a list of acknowledgements at every cycle.
-  -- Implementations don't have to account for finite lists.
-  boolsToBwd :: Proxy a -> [Bool] -> Bwd a
-
 instance Backpressure () where
   boolsToBwd _ _ = ()
 
@@ -196,162 +190,6 @@ prod2C (Circuit a) (Circuit c) =
 
 --------------------------------- SIMULATION -----------------------------------
 
-{- | Specifies option for simulation functions. Don't use this constructor
-directly, as it may be extend with other options in the future. Use 'def'
-instead.
--}
-data SimulationConfig = SimulationConfig
-  { resetCycles :: Int
-  -- ^ Assert reset for a number of cycles before driving the protocol
-  --
-  -- Default: 100
-  , timeoutAfter :: Int
-  -- ^ Timeout after /n/ cycles. Only affects sample functions.
-  --
-  -- Default: 'maxBound'
-  , ignoreReset :: Bool
-  -- ^ Ignore cycles while in reset (sampleC)
-  --
-  -- Default: False
-  }
-  deriving (Show)
-
-instance Default SimulationConfig where
-  def =
-    SimulationConfig
-      { resetCycles = 100
-      , timeoutAfter = maxBound
-      , ignoreReset = False
-      }
-
-{- | Determines what kind of acknowledgement signal 'stallC' will send when its
-input component is not sending any data. Note that, in the Df protocol,
-protocols may send arbitrary acknowledgement signals when this happens.
--}
-data StallAck
-  = -- | Send Nack
-    StallWithNack
-  | -- | Send Ack
-    StallWithAck
-  | -- | Send @errorX "No defined ack"@
-    StallWithErrorX
-  | -- | Passthrough acknowledgement of RHS component
-    StallTransparently
-  | -- | Cycle through all modes
-    StallCycle
-  deriving (Eq, Bounded, Enum, Show)
-
-{- | Class that defines how to /drive/, /sample/, and /stall/ a "Circuit" of
-some shape. The "Backpressure" instance requires that the /backward/ type of the
-circuit can be generated from a list of Booleans.
--}
-class (C.KnownNat (SimulateChannels a), Backpressure a, Simulate a) => Drivable a where
-  -- TODO: documentatie verplaatsen
-  -- Type a /Circuit/ driver needs or sampler yields. For example:
-  --
-  -- >>> :kind! (forall dom a. SimulateFwdType (Df dom a))
-  -- ...
-  -- = [Data a]
-  --
-  -- This means sampling a @Circuit () (Df dom a)@ with 'sampleC' yields
-  -- @[Data a]@.
-
-  -- | Similar to 'SimulateFwdType', but without backpressure information. For
-  -- example:
-  --
-  -- >>> :kind! (forall dom a. ExpectType (Df dom a))
-  -- ...
-  -- = [a]
-  --
-  -- Useful in situations where you only care about the "pure functionality" of
-  -- a circuit, not its timing information. Leveraged by various functions
-  -- in "Protocols.Hedgehog" and 'simulateCS'.
-  type ExpectType a :: Type
-
-  -- | Convert a /ExpectType a/, a type representing data without backpressure,
-  -- into a type that does, /SimulateFwdType a/.
-  toSimulateType ::
-    -- | Type witness
-    Proxy a ->
-    -- | Expect type: input for a protocol /without/ stall information
-    ExpectType a ->
-    -- | Expect type: input for a protocol /with/ stall information
-    SimulateFwdType a
-
-  -- | Convert a /ExpectType a/, a type representing data without backpressure,
-  -- into a type that does, /SimulateFwdType a/.
-  fromSimulateType ::
-    -- | Type witness
-    Proxy a ->
-    -- | Expect type: input for a protocol /with/ stall information
-    SimulateFwdType a ->
-    -- | Expect type: input for a protocol /without/ stall information
-    ExpectType a
-
-  -- | Create a /driving/ circuit. Can be used in combination with 'sampleC'
-  -- to simulate a circuit. Related: 'simulateC'.
-  driveC ::
-    SimulationConfig ->
-    SimulateFwdType a ->
-    Circuit () a
-
-  -- | Sample a circuit that is trivially drivable. Use 'driveC'  to create
-  -- such a circuit. Related: 'simulateC'.
-  sampleC ::
-    SimulationConfig ->
-    Circuit () a ->
-    SimulateFwdType a
-
-{- | Defines functions necessary for implementation of the 'simulateCircuit' function. This
-kind of simulation requires a lists for both the forward and the backward direction.
-
-This class requires the definition of the types that the test supplies and returns. Its
-functions are converters from these /simulation types/ to types on the 'Clash.Signal.Signal' level.
-The 'simulateCircuit' function can thus receive the necessary simulation types, convert
-them to types on the 'Clash.Signal.Signal' level, pass those signals to the circuit, and convert the
-result of the circuit back to the simulation types giving the final result.
--}
-class (C.KnownNat (SimulateChannels a), Protocol a) => Simulate a where
-  -- | The type that a test must provide to the 'simulateCircuit' function in the forward direction.
-  -- Usually this is some sort of list.
-  type SimulateFwdType a :: Type
-
-  -- | The type that a test must provide to the 'simulateCircuit' function in the backward direction.
-  -- Usually this is some sort of list
-  type SimulateBwdType a :: Type
-
-  -- | The number of simulation channels this channel has after flattening it.
-  -- For example, @(Df dom a, Df dom a)@ has 2, while
-  -- @Vec 4 (Df dom a, Df dom a)@ has 8.
-  type SimulateChannels a :: C.Nat
-
-  -- | Convert the forward simulation type to the 'Fwd' of @a@.
-  simToSigFwd :: Proxy a -> SimulateFwdType a -> Fwd a
-
-  -- | Convert the backward simulation type to the 'Bwd' of @a@.
-  simToSigBwd :: Proxy a -> SimulateBwdType a -> Bwd a
-
-  -- | Convert a signal of type @Bwd a@ to the backward simulation type.
-  sigToSimFwd :: Proxy a -> Fwd a -> SimulateFwdType a
-
-  -- | Convert a signal of type @Fwd a@ to the forward simulation type.
-  sigToSimBwd :: Proxy a -> Bwd a -> SimulateBwdType a
-
-  -- | Create a /stalling/ circuit. For each simulation channel (see
-  -- 'SimulateChannels') a tuple determines how the component stalls:
-  --
-  --   * 'StallAck': determines how the backward (acknowledgement) channel
-  --     should behave whenever the component does not receive data from the
-  --     left hand side or when it's intentionally stalling.
-  --
-  --   * A list of 'Int's that determine how many stall cycles to insert on
-  --     every cycle the left hand side component produces data. I.e., stalls
-  --     are /not/ inserted whenever the left hand side does /not/ produce data.
-  stallC ::
-    SimulationConfig ->
-    C.Vec (SimulateChannels a) (StallAck, [Int]) ->
-    Circuit a a
-
 instance Simulate () where
   type SimulateFwdType () = ()
   type SimulateBwdType () = ()