diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 770e61ec..d0432143 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -118,7 +118,7 @@ jobs: version: "0.14.0.0" pattern: | **/*.hs - !clash-protocols-base/src/Protocols/Cpp.hs + !clash-protocols-base/src/Protocols/Plugin/Cpp.hs linting: name: Source code linting diff --git a/clash-protocols-base/clash-protocols-base.cabal b/clash-protocols-base/clash-protocols-base.cabal index a35f14ee..5588fabd 100644 --- a/clash-protocols-base/clash-protocols-base.cabal +++ b/clash-protocols-base/clash-protocols-base.cabal @@ -111,15 +111,16 @@ library , template-haskell exposed-modules: - Protocols.Cpp - Protocols.Internal - Protocols.Internal.Classes - Protocols.Internal.TaggedBundle - Protocols.Internal.TaggedBundle.TH - Protocols.Internal.TH - Protocols.Internal.Units - Protocols.Internal.Units.TH Protocols.Plugin + Protocols.Plugin.Cpp Protocols.Plugin.Internal + Protocols.Plugin.TaggedBundle + Protocols.Plugin.TaggedBundle.TH + Protocols.Plugin.TH + Protocols.Plugin.Units + Protocols.Plugin.Units.TH + + other-modules: + Protocols.Plugin.Types default-language: Haskell2010 diff --git a/clash-protocols-base/src/Protocols/Plugin.hs b/clash-protocols-base/src/Protocols/Plugin.hs index 6258d88d..e4b6b4b4 100644 --- a/clash-protocols-base/src/Protocols/Plugin.hs +++ b/clash-protocols-base/src/Protocols/Plugin.hs @@ -1,11 +1,18 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PatternSynonyms #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} {- | A GHC source plugin providing a DSL for writing Circuit components. Credits to @circuit-notation@ at . -} module Protocols.Plugin ( + -- * Circuit types + Circuit (..), + Protocol (..), + + -- * clash-prelude related types + CSignal, + + -- * plugin functions plugin, circuit, (-<), @@ -14,11 +21,16 @@ module Protocols.Plugin ( -- base import Prelude +-- clash-prelude +import qualified Clash.Explicit.Prelude as C + -- clash-protocols -import Protocols.Internal -import Protocols.Internal.TaggedBundle -import Protocols.Internal.Units +import Protocols.Plugin.Cpp import Protocols.Plugin.Internal +import Protocols.Plugin.TH +import Protocols.Plugin.TaggedBundle +import Protocols.Plugin.Types +import Protocols.Plugin.Units -- circuit-notation import qualified CircuitNotation as CN @@ -29,6 +41,31 @@ import Data.Tagged -- ghc import qualified GHC.Plugins as GHC +instance Protocol () where + type Fwd () = () + type Bwd () = () + +{- | __NB__: The documentation only shows instances up to /3/-tuples. By +default, instances up to and including /12/-tuples will exist. If the flag +@large-tuples@ is set instances up to the GHC imposed limit will exist. The +GHC imposed limit is either 62 or 64 depending on the GHC version. +-} +instance Protocol (a, b) where + type Fwd (a, b) = (Fwd a, Fwd b) + type Bwd (a, b) = (Bwd a, Bwd b) + +-- Generate n-tuple instances, where n > 2 +protocolTupleInstances 3 maxTupleSize + +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) + +-- XXX: Type families with Signals on LHS are currently broken on Clash: +instance Protocol (CSignal dom a) where + type Fwd (CSignal dom a) = C.Signal dom a + type Bwd (CSignal dom a) = C.Signal dom () + -- | @circuit-notation@ plugin repurposed for "Protocols". plugin :: GHC.Plugin plugin = diff --git a/clash-protocols-base/src/Protocols/Cpp.hs b/clash-protocols-base/src/Protocols/Plugin/Cpp.hs similarity index 96% rename from clash-protocols-base/src/Protocols/Cpp.hs rename to clash-protocols-base/src/Protocols/Plugin/Cpp.hs index 82646320..4877c986 100644 --- a/clash-protocols-base/src/Protocols/Cpp.hs +++ b/clash-protocols-base/src/Protocols/Plugin/Cpp.hs @@ -12,7 +12,7 @@ Compile-time dependent constants. Inspired by @clash-prelude@'s @Clash.CPP@. {-# OPTIONS_HADDOCK hide #-} -module Protocols.Cpp +module Protocols.Plugin.Cpp ( maxTupleSize , haddockOnly ) where diff --git a/clash-protocols-base/src/Protocols/Plugin/Internal.hs b/clash-protocols-base/src/Protocols/Plugin/Internal.hs index 6755fa6c..68d6ad1d 100644 --- a/clash-protocols-base/src/Protocols/Plugin/Internal.hs +++ b/clash-protocols-base/src/Protocols/Plugin/Internal.hs @@ -7,7 +7,22 @@ module Protocols.Plugin.Internal where import Clash.Explicit.Prelude import Data.Tagged -import Protocols.Internal +import GHC.Base (Any) +import Protocols.Plugin.Types + +{- | Picked up by "Protocols.Plugin" to process protocol DSL. See +"Protocols.Plugin" for more information. +-} +circuit :: Any +circuit = + error "'circuit' called: did you forget to enable \"Protocols.Plugin\"?" + +{- | Picked up by "Protocols.Plugin" to tie circuits together. See +"Protocols.Plugin" for more information. +-} +(-<) :: Any +(-<) = + error "(-<) called: did you forget to enable \"Protocols.Plugin\"?" {- | Convenience type alias. A circuit where all parts are decorated with a tag, referring to the @a@ and @b@ in its main signature. This is (indirectly) diff --git a/clash-protocols-base/src/Protocols/Plugin/TH.hs b/clash-protocols-base/src/Protocols/Plugin/TH.hs new file mode 100644 index 00000000..a53d2fa8 --- /dev/null +++ b/clash-protocols-base/src/Protocols/Plugin/TH.hs @@ -0,0 +1,36 @@ +{-# OPTIONS_HADDOCK hide #-} + +module Protocols.Plugin.TH where + +import Language.Haskell.TH + +appTs :: Q Type -> [Q Type] -> Q Type +appTs = foldl appT + +-- | Generate @Protocol@ instances for n-tuples +protocolTupleInstances :: Int -> Int -> Q [Dec] +protocolTupleInstances n m = mapM protocolTupleInstance [n .. m] + +protocolTupleInstance :: Int -> Q Dec +protocolTupleInstance n = + instanceD + (pure []) -- context + (protocolConT `appT` tup) -- head + [mkTyInst fwdConName, mkTyInst bwdConName] -- body + where + fwdConName = mkName "Fwd" + bwdConName = mkName "Bwd" + protocolConT = conT (mkName "Protocol") + + tyVars :: [TypeQ] + tyVars = map (varT . mkName . ('a' :) . show) [1 .. n] + + tup = tupleT n `appTs` tyVars + + mkTyInst :: Name -> DecQ + mkTyInst con = + tySynInstD $ tySynEqn Nothing lhs rhs + where + lhs, rhs :: TypeQ + lhs = conT con `appT` tup + rhs = tupleT n `appTs` map (conT con `appT`) tyVars diff --git a/clash-protocols-base/src/Protocols/Internal/TaggedBundle.hs b/clash-protocols-base/src/Protocols/Plugin/TaggedBundle.hs similarity index 92% rename from clash-protocols-base/src/Protocols/Internal/TaggedBundle.hs rename to clash-protocols-base/src/Protocols/Plugin/TaggedBundle.hs index d2f6d3b4..78db9f0e 100644 --- a/clash-protocols-base/src/Protocols/Internal/TaggedBundle.hs +++ b/clash-protocols-base/src/Protocols/Plugin/TaggedBundle.hs @@ -6,12 +6,12 @@ -- For debugging TH: -- {-# OPTIONS_GHC -ddump-splices #-} -module Protocols.Internal.TaggedBundle where +module Protocols.Plugin.TaggedBundle where import Clash.Explicit.Prelude -import Protocols.Cpp (maxTupleSize) -import Protocols.Internal.TaggedBundle.TH (taggedBundleTupleInstances) +import Protocols.Plugin.Cpp (maxTupleSize) +import Protocols.Plugin.TaggedBundle.TH (taggedBundleTupleInstances) import Data.Tagged diff --git a/clash-protocols-base/src/Protocols/Internal/TaggedBundle/TH.hs b/clash-protocols-base/src/Protocols/Plugin/TaggedBundle/TH.hs similarity index 97% rename from clash-protocols-base/src/Protocols/Internal/TaggedBundle/TH.hs rename to clash-protocols-base/src/Protocols/Plugin/TaggedBundle/TH.hs index bcca01c4..67b41588 100644 --- a/clash-protocols-base/src/Protocols/Internal/TaggedBundle/TH.hs +++ b/clash-protocols-base/src/Protocols/Plugin/TaggedBundle/TH.hs @@ -1,6 +1,6 @@ {-# OPTIONS_HADDOCK hide #-} -module Protocols.Internal.TaggedBundle.TH where +module Protocols.Plugin.TaggedBundle.TH where import Data.Tagged import Language.Haskell.TH diff --git a/clash-protocols-base/src/Protocols/Internal/Classes.hs b/clash-protocols-base/src/Protocols/Plugin/Types.hs similarity index 82% rename from clash-protocols-base/src/Protocols/Internal/Classes.hs rename to clash-protocols-base/src/Protocols/Plugin/Types.hs index cba5a44d..bee4b8f6 100644 --- a/clash-protocols-base/src/Protocols/Internal/Classes.hs +++ b/clash-protocols-base/src/Protocols/Plugin/Types.hs @@ -1,3 +1,6 @@ +{-# LANGUAGE RoleAnnotations #-} +{-# OPTIONS_HADDOCK hide #-} + {- | These class definitions are needed to be able to write Template Haskell quotes for instances. They are defined separately to avoid import loops. @@ -5,11 +8,10 @@ for instances. They are defined separately to avoid import loops. This module is not exported; the classes and their (orphan) instances are exported elsewhere. -} -module Protocols.Internal.Classes where +module Protocols.Plugin.Types where import Clash.Signal import Data.Kind (Type) -import Data.Proxy -- | A protocol describes the in- and outputs of one side of a 'Circuit'. class Protocol a where @@ -134,36 +136,12 @@ types: newtype Circuit a b = Circuit ((Fwd a, Bwd b) -> (Bwd a, Fwd b)) -{- | Idle state of a Circuit. Aims to provide no data for both the forward and -backward direction. Transactions are not acknowledged. +{- | Circuit protocol with /Signal dom a/ in its forward direction, and +/()/ in its backward direction. Convenient for exposing protocol +internals, or simply for undirectional streams. +Note: 'CSignal' exists to work around [issue 760](https://github.com/clash-lang/clash-compiler/issues/760) + in Clash, where type families with 'Signal' on the LHS are broken. -} -class (Protocol p) => IdleCircuit p where - idleFwd :: Proxy p -> Fwd (p :: Type) - idleBwd :: Proxy p -> Bwd (p :: Type) +data CSignal (dom :: Domain) (a :: Type) -{- | Force a /nack/ on the backward channel and /no data/ on the forward -channel if reset is asserted. --} -forceResetSanityGeneric :: - forall dom a fwd bwd. - ( KnownDomain dom - , HiddenReset dom - , IdleCircuit a - , Fwd a ~ Signal dom fwd - , Bwd a ~ Signal dom bwd - ) => - Circuit a a -forceResetSanityGeneric = Circuit go - where - go (fwd, bwd) = - unbundle $ - mux - rstAsserted - (bundle (idleBwd $ Proxy @a, idleFwd $ Proxy @a)) - (bundle (bwd, fwd)) - -#if MIN_VERSION_clash_prelude(1,8,0) - rstAsserted = unsafeToActiveHigh hasReset -#else - rstAsserted = unsafeToHighPolarity hasReset -#endif +type role CSignal nominal representational diff --git a/clash-protocols-base/src/Protocols/Internal/Units.hs b/clash-protocols-base/src/Protocols/Plugin/Units.hs similarity index 90% rename from clash-protocols-base/src/Protocols/Internal/Units.hs rename to clash-protocols-base/src/Protocols/Plugin/Units.hs index e5b29e03..9da0ab58 100644 --- a/clash-protocols-base/src/Protocols/Internal/Units.hs +++ b/clash-protocols-base/src/Protocols/Plugin/Units.hs @@ -5,12 +5,12 @@ -- For debugging TH: -- {-# OPTIONS_GHC -ddump-splices #-} -module Protocols.Internal.Units where +module Protocols.Plugin.Units where import Clash.Explicit.Prelude -import Protocols.Cpp (maxTupleSize) -import Protocols.Internal.Units.TH (unitsTupleInstances) +import Protocols.Plugin.Cpp (maxTupleSize) +import Protocols.Plugin.Units.TH (unitsTupleInstances) {- | Utilities for zero-width types. Is used by "Protocols.Plugin" to drive \"trivial\" backwards channels. diff --git a/clash-protocols-base/src/Protocols/Internal/Units/TH.hs b/clash-protocols-base/src/Protocols/Plugin/Units/TH.hs similarity index 91% rename from clash-protocols-base/src/Protocols/Internal/Units/TH.hs rename to clash-protocols-base/src/Protocols/Plugin/Units/TH.hs index c8c51dee..7841fb10 100644 --- a/clash-protocols-base/src/Protocols/Internal/Units/TH.hs +++ b/clash-protocols-base/src/Protocols/Plugin/Units/TH.hs @@ -1,6 +1,6 @@ {-# OPTIONS_HADDOCK hide #-} -module Protocols.Internal.Units.TH (unitsTupleInstances) where +module Protocols.Plugin.Units.TH (unitsTupleInstances) where import Language.Haskell.TH diff --git a/clash-protocols/clash-protocols.cabal b/clash-protocols/clash-protocols.cabal index 1017ec5b..9c2a62b3 100644 --- a/clash-protocols/clash-protocols.cabal +++ b/clash-protocols/clash-protocols.cabal @@ -145,10 +145,12 @@ library Protocols.Axi4.WriteData Protocols.Axi4.WriteResponse Protocols.Df + Protocols.Internal Protocols.DfConv Protocols.Hedgehog Protocols.Hedgehog.Internal Protocols.Idle + Protocols.Internal.TH Protocols.Wishbone Protocols.Wishbone.Standard Protocols.Wishbone.Standard.Hedgehog @@ -163,6 +165,7 @@ library autogen-modules: Paths_clash_protocols other-modules: + Protocols.Internal.Types Paths_clash_protocols default-language: Haskell2010 diff --git a/clash-protocols/src/Protocols.hs b/clash-protocols/src/Protocols.hs index 0d2b1aff..0fbf89b5 100644 --- a/clash-protocols/src/Protocols.hs +++ b/clash-protocols/src/Protocols.hs @@ -59,12 +59,10 @@ module Protocols ( -- * Circuit notation plugin circuit, (-<), - module Protocols.Internal.Units, - module Protocols.Internal.TaggedBundle, + Units (..), + TaggedBundle (..), ) where import Data.Default (def) import Protocols.Df (Df) import Protocols.Internal -import Protocols.Internal.TaggedBundle -import Protocols.Internal.Units diff --git a/clash-protocols/src/Protocols/Axi4/ReadAddress.hs b/clash-protocols/src/Protocols/Axi4/ReadAddress.hs index e165fb92..7dde8f45 100644 --- a/clash-protocols/src/Protocols/Axi4/ReadAddress.hs +++ b/clash-protocols/src/Protocols/Axi4/ReadAddress.hs @@ -49,6 +49,7 @@ import qualified Clash.Prelude as C -- me import Protocols.Axi4.Common +import Protocols.Idle import Protocols.Internal -- | Configuration options for 'Axi4ReadAddress'. diff --git a/clash-protocols/src/Protocols/Axi4/Stream.hs b/clash-protocols/src/Protocols/Axi4/Stream.hs index 4c093d8d..818c1f23 100644 --- a/clash-protocols/src/Protocols/Axi4/Stream.hs +++ b/clash-protocols/src/Protocols/Axi4/Stream.hs @@ -27,6 +27,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.Idle import Protocols.Internal instance (KnownNat n) => Hashable (Unsigned n) diff --git a/clash-protocols/src/Protocols/Axi4/WriteAddress.hs b/clash-protocols/src/Protocols/Axi4/WriteAddress.hs index 6ebb67d3..b902b17f 100644 --- a/clash-protocols/src/Protocols/Axi4/WriteAddress.hs +++ b/clash-protocols/src/Protocols/Axi4/WriteAddress.hs @@ -47,6 +47,7 @@ import qualified Clash.Prelude as C -- me import Protocols.Axi4.Common +import Protocols.Idle import Protocols.Internal -- | Configuration options for 'Axi4WriteAddress'. diff --git a/clash-protocols/src/Protocols/Df.hs b/clash-protocols/src/Protocols/Df.hs index 98a31be8..29eddc56 100644 --- a/clash-protocols/src/Protocols/Df.hs +++ b/clash-protocols/src/Protocols/Df.hs @@ -129,6 +129,7 @@ import qualified Clash.Prelude as C import Clash.Signal.Internal (Signal (..)) -- me +import Protocols.Idle import Protocols.Internal {-# ANN module "HLint: ignore Use const" #-} diff --git a/clash-protocols/src/Protocols/Idle.hs b/clash-protocols/src/Protocols/Idle.hs index 6f7e6114..8d052221 100644 --- a/clash-protocols/src/Protocols/Idle.hs +++ b/clash-protocols/src/Protocols/Idle.hs @@ -4,24 +4,30 @@ Functionalities to easily create idle circuits for protocols. -} module Protocols.Idle ( + -- * Type classes IdleCircuit (..), + + -- * Utility functions idleSource, idleSink, + forceResetSanityGeneric, ) where -import qualified Clash.Prelude as C +import Clash.Prelude +import Prelude () + import Data.Proxy -import Protocols.Cpp (maxTupleSize) import Protocols.Internal import Protocols.Internal.TH (idleCircuitTupleInstances) +import Protocols.Plugin.Cpp (maxTupleSize) instance (IdleCircuit a, IdleCircuit b) => IdleCircuit (a, b) where idleFwd _ = (idleFwd $ Proxy @a, idleFwd $ Proxy @b) idleBwd _ = (idleBwd $ Proxy @a, idleBwd $ Proxy @b) -instance (IdleCircuit a, C.KnownNat n) => IdleCircuit (C.Vec n a) where - idleFwd _ = C.repeat $ idleFwd $ Proxy @a - idleBwd _ = C.repeat $ idleBwd $ Proxy @a +instance (IdleCircuit a, KnownNat n) => IdleCircuit (Vec n a) where + idleFwd _ = repeat $ idleFwd $ Proxy @a + idleBwd _ = repeat $ idleBwd $ Proxy @a instance IdleCircuit () where idleFwd _ = () @@ -37,3 +43,30 @@ idleSource = Circuit $ const ((), idleFwd $ Proxy @p) -- | Idle state of a sink, this circuit does not consume any data. idleSink :: forall p. (IdleCircuit p) => Circuit p () idleSink = Circuit $ const (idleBwd $ Proxy @p, ()) + +{- | Force a /nack/ on the backward channel and /no data/ on the forward +channel if reset is asserted. +-} +forceResetSanityGeneric :: + forall dom a fwd bwd. + ( KnownDomain dom + , HiddenReset dom + , IdleCircuit a + , Fwd a ~ Signal dom fwd + , Bwd a ~ Signal dom bwd + ) => + Circuit a a +forceResetSanityGeneric = Circuit go + where + go (fwd, bwd) = + unbundle + $ mux + rstAsserted + (bundle (idleBwd $ Proxy @a, idleFwd $ Proxy @a)) + (bundle (bwd, fwd)) + +#if MIN_VERSION_clash_prelude(1,8,0) + rstAsserted = unsafeToActiveHigh hasReset +#else + rstAsserted = unsafeToHighPolarity hasReset +#endif diff --git a/clash-protocols-base/src/Protocols/Internal.hs b/clash-protocols/src/Protocols/Internal.hs similarity index 91% rename from clash-protocols-base/src/Protocols/Internal.hs rename to clash-protocols/src/Protocols/Internal.hs index d82318b7..786a77ef 100644 --- a/clash-protocols-base/src/Protocols/Internal.hs +++ b/clash-protocols/src/Protocols/Internal.hs @@ -5,7 +5,9 @@ {-# LANGUAGE RoleAnnotations #-} {-# LANGUAGE TypeFamilyDependencies #-} {-# LANGUAGE UndecidableInstances #-} +#if !MIN_VERSION_clash_prelude(1, 8, 2) {-# OPTIONS_GHC -fno-warn-orphans #-} +#endif -- TODO: Hide internal documentation -- {-# OPTIONS_HADDOCK hide #-} @@ -15,23 +17,26 @@ Internal module to prevent hs-boot files (breaks Haddock) -} module Protocols.Internal ( module Protocols.Internal, - module Protocols.Internal.Classes, + module Protocols.Internal.Types, + module Protocols.Plugin, + module Protocols.Plugin.Units, + module Protocols.Plugin.TaggedBundle, ) where import Control.DeepSeq (NFData) import Data.Hashable (Hashable) import Data.Maybe (fromMaybe) import Data.Proxy -import GHC.Base (Any) import Prelude hiding (const, map) import qualified Clash.Explicit.Prelude as CE -import Clash.Prelude (Signal, type (*), type (+)) +import Clash.Prelude (type (*), type (+)) import qualified Clash.Prelude as C -import Protocols.Cpp (maxTupleSize) -import Protocols.Internal.Classes -import Protocols.Internal.TH (protocolTupleInstances) +import Protocols.Internal.Types +import Protocols.Plugin +import Protocols.Plugin.TaggedBundle +import Protocols.Plugin.Units import Control.Arrow ((***)) import Data.Coerce (coerce) @@ -53,42 +58,6 @@ newtype Ack = Ack Bool instance Default Ack where def = Ack True -{- | Circuit protocol with /Signal dom a/ in its forward direction, and -/()/ in its backward direction. Convenient for exposing protocol -internals, or simply for undirectional streams. - -Note: 'CSignal' exists to work around [issue 760](https://github.com/clash-lang/clash-compiler/issues/760) - in Clash, where type families with 'Signal' on the LHS are broken. --} -data CSignal (dom :: CE.Domain) (a :: Type) - -type role CSignal nominal representational - -instance Protocol () where - type Fwd () = () - type Bwd () = () - -{- | __NB__: The documentation only shows instances up to /3/-tuples. By -default, instances up to and including /12/-tuples will exist. If the flag -@large-tuples@ is set instances up to the GHC imposed limit will exist. The -GHC imposed limit is either 62 or 64 depending on the GHC version. --} -instance Protocol (a, b) where - type Fwd (a, b) = (Fwd a, Fwd b) - type Bwd (a, b) = (Bwd a, Bwd b) - --- Generate n-tuple instances, where n > 2 -protocolTupleInstances 3 maxTupleSize - -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) - --- XXX: Type families with Signals on LHS are currently broken on Clash: -instance Protocol (CSignal dom a) where - type Fwd (CSignal dom a) = Signal dom a - type Bwd (CSignal dom a) = Signal dom () - {- | Left-to-right circuit composition. @ @@ -337,9 +306,9 @@ class (C.KnownNat (SimulateChannels a), Backpressure a, Simulate a) => Drivable 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 'Signal' level. +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 'Signal' level, pass those signals to the circuit, and convert the +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 @@ -610,20 +579,6 @@ simulateCircuit fwds bwds circ = toSignals circ $ (simToSigFwd (Proxy @a) fwds, simToSigBwd (Proxy @b) bwds) -{- | Picked up by "Protocols.Plugin" to process protocol DSL. See -"Protocols.Plugin" for more information. --} -circuit :: Any -circuit = - error "'protocol' called: did you forget to enable \"Protocols.Plugin\"?" - -{- | Picked up by "Protocols.Plugin" to tie circuits together. See -"Protocols.Plugin" for more information. --} -(-<) :: Any -(-<) = - error "(-<) called: did you forget to enable \"Protocols.Plugin\"?" - {- | Allows for optional data. Depending on the value of @keep@, the data can either be included or left out. When left out, the data is represented instead as type @()@. diff --git a/clash-protocols-base/src/Protocols/Internal/TH.hs b/clash-protocols/src/Protocols/Internal/TH.hs similarity index 56% rename from clash-protocols-base/src/Protocols/Internal/TH.hs rename to clash-protocols/src/Protocols/Internal/TH.hs index 7914c5d5..72743204 100644 --- a/clash-protocols-base/src/Protocols/Internal/TH.hs +++ b/clash-protocols/src/Protocols/Internal/TH.hs @@ -4,38 +4,7 @@ module Protocols.Internal.TH where import Control.Monad.Extra (concatMapM) import Language.Haskell.TH - -import Protocols.Internal.Classes - -appTs :: Q Type -> [Q Type] -> Q Type -appTs = foldl appT - -protocolTupleInstances :: Int -> Int -> Q [Dec] -protocolTupleInstances n m = mapM protocolTupleInstance [n .. m] - -protocolTupleInstance :: Int -> Q Dec -protocolTupleInstance n = - instanceD - (pure []) -- context - (protocolConT `appT` tup) -- head - [mkTyInst fwdConName, mkTyInst bwdConName] -- body - where - fwdConName = mkName "Fwd" - bwdConName = mkName "Bwd" - protocolConT = conT (mkName "Protocol") - - tyVars :: [TypeQ] - tyVars = map (varT . mkName . ('a' :) . show) [1 .. n] - - tup = tupleT n `appTs` tyVars - - mkTyInst :: Name -> DecQ - mkTyInst con = - tySynInstD $ tySynEqn Nothing lhs rhs - where - lhs, rhs :: TypeQ - lhs = conT con `appT` tup - rhs = tupleT n `appTs` map (conT con `appT`) tyVars +import Protocols.Internal.Types {- | Template haskell function to generate IdleCircuit instances for the tuples n through m inclusive. To see a 2-tuple version of the pattern we generate, diff --git a/clash-protocols/src/Protocols/Internal/Types.hs b/clash-protocols/src/Protocols/Internal/Types.hs new file mode 100644 index 00000000..8303818e --- /dev/null +++ b/clash-protocols/src/Protocols/Internal/Types.hs @@ -0,0 +1,12 @@ +module Protocols.Internal.Types where + +import Data.Proxy +import GHC.Base (Type) +import Protocols.Plugin + +{- | Idle state of a Circuit. Aims to provide no data for both the forward and +backward direction. Transactions are not acknowledged. +-} +class (Protocol p) => IdleCircuit p where + idleFwd :: Proxy p -> Fwd (p :: Type) + idleBwd :: Proxy p -> Bwd (p :: Type) diff --git a/clash-protocols/src/Protocols/Wishbone.hs b/clash-protocols/src/Protocols/Wishbone.hs index ac22ed71..689d26d1 100644 --- a/clash-protocols/src/Protocols/Wishbone.hs +++ b/clash-protocols/src/Protocols/Wishbone.hs @@ -15,7 +15,7 @@ import Prelude hiding (head, not, (&&)) import Clash.Signal.Internal (Signal (..)) import Control.DeepSeq (NFData) import Protocols -import Protocols.Internal.Classes +import Protocols.Idle import qualified Clash.Prelude as C diff --git a/format.sh b/format.sh index 3c39cb99..5f899790 100755 --- a/format.sh +++ b/format.sh @@ -24,7 +24,7 @@ if [[ "$#" -eq 0 || "$1" == "-h" || "$1" == "--help" ]]; then fi exclude_files=( - "clash-protocols-base/src/Protocols/Cpp.hs" + "clash-protocols-base/src/Protocols/Plugin/Cpp.hs" "dist-newstyle" )