Add ToConst and ToConstBwd protocols (#182)

Author: martijnbastiaan

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

@@ -8,6 +8,8 @@ module Protocols.Plugin (
   -- * Circuit types
   Circuit (..),
   Protocol (..),
+  ToConst,
+  ToConstBwd,
 
   -- * clash-prelude related types
   CSignal,
@@ -19,6 +21,8 @@ module Protocols.Plugin (
 ) where
 
 -- base
+
+import Data.Kind (Type)
 import Prelude
 
 -- clash-prelude
@@ -57,6 +61,24 @@ instance Protocol (a, b) where
 -- Generate n-tuple instances, where n > 2
 protocolTupleInstances 3 maxTupleSize
 
+{- | A protocol that carries a constant value in the forward direction and no
+information in the backward direction.
+-}
+data ToConst (a :: Type)
+
+instance Protocol (ToConst a) where
+  type Fwd (ToConst a) = a
+  type Bwd (ToConst a) = ()
+
+{- | A protocol that carries no information in the forward direction and a
+constant value in the backward direction.
+-}
+data ToConstBwd (a :: Type)
+
+instance Protocol (ToConstBwd a) where
+  type Fwd (ToConstBwd a) = ()
+  type Bwd (ToConstBwd a) = a
+
 instance (C.KnownNat n) => Protocol (C.Vec n a) where
   type Fwd (C.Vec n a) = C.Vec n (Fwd a)
   type Bwd (C.Vec n a) = C.Vec n (Bwd a)

clash-protocols/clash-protocols.cabal

@@ -125,23 +125,24 @@ library
     Protocols.Axi4.WriteAddress
     Protocols.Axi4.WriteData
     Protocols.Axi4.WriteResponse
+    Protocols.Df
+    Protocols.DfConv
+    Protocols.Hedgehog
+    Protocols.Hedgehog.Internal
+    Protocols.Idle
+    Protocols.Internal
+    Protocols.Internal.TH
     Protocols.PacketStream
-    Protocols.PacketStream.Base
     Protocols.PacketStream.AsyncFifo
+    Protocols.PacketStream.Base
     Protocols.PacketStream.Converters
     Protocols.PacketStream.Depacketizers
     Protocols.PacketStream.Hedgehog
     Protocols.PacketStream.PacketFifo
     Protocols.PacketStream.Packetizers
     Protocols.PacketStream.Padding
     Protocols.PacketStream.Routing
-    Protocols.Df
-    Protocols.DfConv
-    Protocols.Hedgehog
-    Protocols.Hedgehog.Internal
-    Protocols.Idle
-    Protocols.Internal
-    Protocols.Internal.TH
+    Protocols.ToConst
     Protocols.Vec
     Protocols.Wishbone
     Protocols.Wishbone.Standard

clash-protocols/src/Protocols.hs

@@ -26,6 +26,8 @@ module Protocols (
   -- * Protocol types
   CSignal,
   Df,
+  ToConst,
+  ToConstBwd,
 
   -- * Basic circuits
   idC,

clash-protocols/src/Protocols/ToConst.hs

@@ -0,0 +1,31 @@
+{- | Definitions for the 'ToConst' protocol. Usable to pass constant values in
+circuits.
+-}
+module Protocols.ToConst (
+  ToConst,
+  ToConstBwd,
+  to,
+  from,
+  toBwd,
+  fromBwd,
+) where
+
+import Protocols.Plugin (Circuit (..), ToConst, ToConstBwd)
+
+-- | Convert a value to a 'Circuit' that produces a constant value.
+to :: a -> Circuit () (ToConst a)
+to a = Circuit (\_ -> ((), a))
+
+-- | Extract the constant value
+from :: Circuit () (ToConst a) -> a
+from (Circuit f) = snd (f ((), ()))
+
+{- | Convert a value to a 'Circuit' that produces a constant value in the
+backward direction.
+-}
+toBwd :: a -> Circuit (ToConstBwd a) ()
+toBwd a = Circuit (\_ -> (a, ()))
+
+-- | Extract the constant value from the backward direction.
+fromBwd :: Circuit (ToConstBwd a) () -> a
+fromBwd (Circuit f) = fst (f ((), ()))