diff --git a/clash-prelude/src/Clash/Clocks/Internal.hs b/clash-prelude/src/Clash/Clocks/Internal.hs index 3c3a4a6970..d8f165e18f 100644 --- a/clash-prelude/src/Clash/Clocks/Internal.hs +++ b/clash-prelude/src/Clash/Clocks/Internal.hs @@ -27,7 +27,6 @@ import Clash.CPP (haddockOnly) import Clash.Explicit.Reset (resetSynchronizer) import Clash.Explicit.Signal (unsafeSynchronizer) import Clash.Magic (setName) -import Clash.Promoted.Symbol (SSymbol(..)) import Clash.Signal.Internal (clockGen, Clock(..), Domain, KnownDomain, Reset, Signal, unsafeFromActiveLow, unsafeToActiveLow) @@ -51,7 +50,7 @@ deriveClocksInstance n = type ClocksCxt $instType = $cxtType type NumOutClocks $instType = $numOutClocks - clocks (Clock _ Nothing) $(varP rst) = $funcImpl + clocks (Clock Nothing) $(varP rst) = $funcImpl clocks _ _ = error "clocks: dynamic clocks unsupported" {-# OPAQUE clocks #-} |] @@ -73,7 +72,7 @@ deriveClocksInstance n = lockImpl = [| unsafeSynchronizer clockGen clockGen (unsafeToActiveLow $(varE rst)) |] - clkImpls = replicate n [| Clock SSymbol Nothing |] + clkImpls = replicate n [| Clock Nothing |] funcImpl = tupE $ clkImpls <> [lockImpl] -- Derive instances for up to and including 18 clocks, except when we are diff --git a/clash-prelude/src/Clash/Explicit/BlockRam.hs b/clash-prelude/src/Clash/Explicit/BlockRam.hs index ef03ba0298..0bfa15cf6c 100644 --- a/clash-prelude/src/Clash/Explicit/BlockRam.hs +++ b/clash-prelude/src/Clash/Explicit/BlockRam.hs @@ -1065,7 +1065,7 @@ blockRam# -- ^ Value to write (at address @w@) -> Signal dom a -- ^ Value of the BRAM at address @r@ from the previous clock cycle -blockRam# (Clock _ Nothing) gen content = \rd wen waS wd -> runST $ do +blockRam# (Clock Nothing) gen content = \rd wen waS wd -> runST $ do ramStart <- newListArray (0,szI-1) contentL -- start benchmark only -- ramStart <- unsafeThawSTArray ramArr diff --git a/clash-prelude/src/Clash/Explicit/BlockRam/File.hs b/clash-prelude/src/Clash/Explicit/BlockRam/File.hs index 0d3feed3a7..eea777f2dd 100644 --- a/clash-prelude/src/Clash/Explicit/BlockRam/File.hs +++ b/clash-prelude/src/Clash/Explicit/BlockRam/File.hs @@ -333,7 +333,7 @@ blockRamFile# -- ^ Value to write (at address @w@) -> Signal dom (BitVector m) -- ^ Value of the BRAM at address @r@ from the previous clock cycle -blockRamFile# (Clock _ Nothing) ena sz file = \rd wen waS wd -> runST $ do +blockRamFile# (Clock Nothing) ena sz file = \rd wen waS wd -> runST $ do ramStart <- newArray_ (0,szI) unsafeIOToST (withFile file ReadMode (\h -> forM_ [0..(szI-1)] (\i -> do diff --git a/clash-prelude/src/Clash/Explicit/DDR.hs b/clash-prelude/src/Clash/Explicit/DDR.hs index 811c190a00..936ef17914 100644 --- a/clash-prelude/src/Clash/Explicit/DDR.hs +++ b/clash-prelude/src/Clash/Explicit/DDR.hs @@ -51,9 +51,12 @@ import Clash.Signal.Internal >>> import Clash.Explicit.DDR >>> :{ type DDR = "DDR" :: Domain -instance KnownDomain "DDR" where - type KnownConf "DDR" = 'DomainConfiguration "DDR" 5000 'Rising 'Asynchronous 'Defined 'ActiveHigh - knownDomain = SDomainConfiguration SSymbol SNat SRising SAsynchronous SDefined SActiveHigh +instance KnownDomain DDR where + type DomainPeriod DDR = 5000 + type DomainActiveEdge DDR = 'Rising + type DomainResetKind DDR = 'Asynchronous + type DomainInitBehavior DDR = 'Defined + type DomainResetPolarity DDR = 'ActiveHigh :} -} @@ -115,7 +118,7 @@ ddrIn# -> a -> Signal domDDR a -> Signal dom (a,a) -ddrIn# (Clock _ Nothing) (unsafeToActiveHigh -> hRst) (fromEnable -> ena) i0 i1 i2 = +ddrIn# (Clock Nothing) (unsafeToActiveHigh -> hRst) (fromEnable -> ena) i0 i1 i2 = case resetKind @domDDR of SAsynchronous -> goAsync @@ -305,8 +308,8 @@ ddrForwardClock# => Clock domIn -> Signal domDDR Bit -> Clock domOut -ddrForwardClock# (Clock SSymbol periods) ddrSignal = - Clock (ddrSignal `seq` SSymbol) (unsafeCoerce periods) +ddrForwardClock# (Clock periods) ddrSignal = + Clock (ddrSignal `seq` unsafeCoerce periods) {-# OPAQUE ddrForwardClock# #-} {-# ANN ddrForwardClock# ( let diff --git a/clash-prelude/src/Clash/Explicit/Prelude.hs b/clash-prelude/src/Clash/Explicit/Prelude.hs index 0893fd7d2c..25b5fe1992 100644 --- a/clash-prelude/src/Clash/Explicit/Prelude.hs +++ b/clash-prelude/src/Clash/Explicit/Prelude.hs @@ -16,6 +16,7 @@ defined in "Clash.Prelude". {-# LANGUAGE Unsafe #-} +{-# OPTIONS_GHC -fplugin=GHC.TypeLits.Normalise #-} {-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-} {-# OPTIONS_HADDOCK show-extensions, not-home #-} diff --git a/clash-prelude/src/Clash/Explicit/Signal.hs b/clash-prelude/src/Clash/Explicit/Signal.hs index b1b88f77b9..12876633e1 100644 --- a/clash-prelude/src/Clash/Explicit/Signal.hs +++ b/clash-prelude/src/Clash/Explicit/Signal.hs @@ -46,9 +46,12 @@ made. Clash provides a standard implementation, called 'System', that is configured as follows: @ -instance KnownDomain 'System' where - type KnownConf 'System' = 'DomainConfiguration 'System' 10000 'Rising 'Asynchronous 'Defined 'ActiveHigh - knownDomain = 'SDomainConfiguration' SSymbol SNat 'SRising' 'SAsynchronous' 'SDefined' 'SActiveHigh' +instance KnownDomain System where + type DomainPeriod System = 10000 + type DomainActiveEdge System = 'Rising + type DomainResetKind System = 'Asynchronous + type DomainInitBehavior System = 'Defined + type DomainResetPolarity System = 'ActiveHigh @ In words, \"System\" is a synthesis domain with a clock running with a period @@ -166,12 +169,6 @@ module Clash.Explicit.Signal , SResetPolarity(..) , DomainConfiguration(..) , SDomainConfiguration(..) - -- ** Configuration type families - , DomainPeriod - , DomainActiveEdge - , DomainResetKind - , DomainInitBehavior - , DomainResetPolarity -- *** Convenience types #conveniencetypes# -- $conveniencetypes @@ -200,6 +197,7 @@ module Clash.Explicit.Signal -- ** Domain utilities , VDomainConfiguration(..) , vDomain + , knownDomain , createDomain , knownVDomain , clockPeriod @@ -320,14 +318,20 @@ import Clash.XException >>> import qualified Data.List as L >>> :{ instance KnownDomain "Dom2" where - type KnownConf "Dom2" = 'DomainConfiguration "Dom2" 2 'Rising 'Asynchronous 'Defined 'ActiveHigh - knownDomain = SDomainConfiguration SSymbol SNat SRising SAsynchronous SDefined SActiveHigh + type DomainPeriod "Dom2" = 2 + type DomainActiveEdge "Dom2" = 'Rising + type DomainResetKind "Dom2" = 'Asynchronous + type DomainInitBehavior "Dom2" = 'Defined + type DomainResetPolarity "Dom2" = 'ActiveHigh :} >>> :{ instance KnownDomain "Dom7" where - type KnownConf "Dom7" = 'DomainConfiguration "Dom7" 7 'Rising 'Asynchronous 'Defined 'ActiveHigh - knownDomain = SDomainConfiguration SSymbol SNat SRising SAsynchronous SDefined SActiveHigh + type DomainPeriod "Dom7" = 7 + type DomainActiveEdge "Dom7" = 'Rising + type DomainResetKind "Dom7" = 'Asynchronous + type DomainInitBehavior "Dom7" = 'Defined + type DomainResetPolarity "Dom7" = 'ActiveHigh :} >>> type Dom2 = "Dom2" diff --git a/clash-prelude/src/Clash/Explicit/Testbench.hs b/clash-prelude/src/Clash/Explicit/Testbench.hs index 981e0774c6..0a7c6703c8 100644 --- a/clash-prelude/src/Clash/Explicit/Testbench.hs +++ b/clash-prelude/src/Clash/Explicit/Testbench.hs @@ -41,6 +41,7 @@ where import Control.Exception (catch, evaluate) import Debug.Trace (trace) +import Data.Proxy (Proxy(..)) import GHC.TypeLits (KnownNat, type (+), type (<=)) import Prelude hiding ((!!), length) import System.IO.Unsafe (unsafeDupablePerformIO) @@ -48,7 +49,6 @@ import System.IO.Unsafe (unsafeDupablePerformIO) import Clash.Annotations.Primitive (hasBlackBox) import Clash.Class.Num (satSucc, SaturationMode(SatBound)) import Clash.Promoted.Nat (SNat(..)) -import Clash.Promoted.Symbol (SSymbol(..)) import Clash.Explicit.Signal (Clock, Reset, System, Signal, toEnable, fromList, register, unbundle, unsafeSynchronizer) @@ -475,7 +475,7 @@ clockToDiffClock :: Clock dom -> -- | Differential output DiffClock dom -clockToDiffClock clk = DiffClock clk (ClockN SSymbol) +clockToDiffClock clk = DiffClock clk (ClockN Proxy) {-# OPAQUE clockToDiffClock #-} {-# ANN clockToDiffClock hasBlackBox #-} diff --git a/clash-prelude/src/Clash/Signal.hs b/clash-prelude/src/Clash/Signal.hs index 945c8733d0..8fe8ef19b1 100644 --- a/clash-prelude/src/Clash/Signal.hs +++ b/clash-prelude/src/Clash/Signal.hs @@ -45,9 +45,12 @@ made. Clash provides an implementation 'System' with some common options chosen: @ -instance KnownDomain 'System' where - type KnownConf 'System' = 'DomainConfiguration 'System' 10000 'Rising 'Asynchronous 'Defined 'ActiveHigh - knownDomain = SDomainConfiguration SSymbol SNat SRising SAsynchronous SDefined SActiveHigh +instance KnownDomain System where + type DomainPeriod System = 10000 + type DomainActiveEdge System = 'Rising + type DomainResetKind System = 'Asynchronous + type DomainInitBehavior System = 'Defined + type DomainResetPolarity System = 'ActiveHigh @ In words, \"System\" is a synthesis domain with a clock running with a period @@ -100,12 +103,6 @@ module Clash.Signal , SResetPolarity(..) , DomainConfiguration(..) , SDomainConfiguration(..) - -- ** Configuration type families - , DomainPeriod - , DomainActiveEdge - , DomainResetKind - , DomainInitBehavior - , DomainResetPolarity -- *** Convenience types -- $conveniencetypes @@ -134,6 +131,7 @@ module Clash.Signal -- ** Domain utilities , VDomainConfiguration(..) , vDomain + , knownDomain , createDomain , knownVDomain , clockPeriod diff --git a/clash-prelude/src/Clash/Signal/Internal.hs b/clash-prelude/src/Clash/Signal/Internal.hs index dba102088e..c4a4e9b5ba 100644 --- a/clash-prelude/src/Clash/Signal/Internal.hs +++ b/clash-prelude/src/Clash/Signal/Internal.hs @@ -44,7 +44,9 @@ module Clash.Signal.Internal , Domain , sameDomain , KnownDomain(..) + , KnownConf , KnownConfiguration + , knownDomain , knownDomainByName , ActiveEdge(..) , SActiveEdge(..) @@ -57,18 +59,11 @@ module Clash.Signal.Internal , DomainConfiguration(..) , SDomainConfiguration(..) -- ** Configuration type families - , DomainPeriod - , DomainActiveEdge - , DomainResetKind - , DomainInitBehavior - , DomainResetPolarity - , DomainConfigurationPeriod , DomainConfigurationActiveEdge , DomainConfigurationResetKind , DomainConfigurationInitBehavior , DomainConfigurationResetPolarity - -- *** Convenience types , HasSynchronousReset , HasAsynchronousReset @@ -182,7 +177,7 @@ module Clash.Signal.Internal where import Data.IORef (IORef, atomicModifyIORef, newIORef, readIORef) -import Type.Reflection (Typeable) +import Type.Reflection (Typeable, typeRep) import Control.Arrow.Transformer.Automaton import Control.Applicative (liftA3) import Control.DeepSeq (NFData) @@ -197,14 +192,14 @@ import Data.Int (Int64) import Data.Maybe (isJust) import Data.Proxy (Proxy(..)) import Data.Ratio (Ratio) -import Data.Type.Equality ((:~:)) +import Data.Type.Equality ((:~:), testEquality) import GHC.Generics (Generic) import GHC.Stack (HasCallStack, withFrozenCallStack) -import GHC.TypeLits - (Div, KnownSymbol, KnownNat, Nat, Symbol, type (<=), type (*), sameSymbol) +import GHC.Types (Type) +import GHC.TypeLits (Div, KnownNat, Nat, type (<=), type (*), type (-)) import GHC.TypeLits.Extra (DivRU) import GHC.Records (HasField(getField)) -import Language.Haskell.TH.Syntax -- (Lift (..), Q, Dec) +import Language.Haskell.TH.Syntax hiding (Type) -- (Lift (..), Q, Dec) import Language.Haskell.TH.Compat import Numeric.Natural (Natural) import System.IO.Unsafe (unsafeInterleaveIO, unsafePerformIO) @@ -215,7 +210,6 @@ import Clash.Class.Num (SaturatingNum(..)) import Clash.CPP (fStrictMapSignal) import Clash.NamedTypes import Clash.Promoted.Nat (SNat (..), snatToNum, snatToNatural) -import Clash.Promoted.Symbol (SSymbol (..), ssymbolToString) import Clash.XException (NFDataX(..), errorX, isX, deepseqX, defaultSeqX, seqX) @@ -366,32 +360,6 @@ type family DomainConfigurationInitBehavior (config :: DomainConfiguration) :: I type family DomainConfigurationResetPolarity (config :: DomainConfiguration) :: ResetPolarity where DomainConfigurationResetPolarity ('DomainConfiguration name period edge reset init polarity) = polarity --- | Convenience type to help to extract a period from a domain. Example usage: --- --- @ --- myFunc :: (KnownDomain dom, DomainPeriod dom ~ 6000) => ... --- @ -type DomainPeriod (dom :: Domain) = - DomainConfigurationPeriod (KnownConf dom) - --- | Convenience type to help to extract the active edge from a domain. Example --- usage: --- --- @ --- myFunc :: (KnownDomain dom, DomainActiveEdge dom ~ 'Rising) => ... --- @ -type DomainActiveEdge (dom :: Domain) = - DomainConfigurationActiveEdge (KnownConf dom) - --- | Convenience type to help to extract the reset synchronicity from a --- domain. Example usage: --- --- @ --- myFunc :: (KnownDomain dom, DomainResetKind dom ~ 'Synchronous) => ... --- @ -type DomainResetKind (dom :: Domain) = - DomainConfigurationResetKind (KnownConf dom) - -- | Convenience type to constrain a domain to have synchronous resets. Example -- usage: -- @@ -418,15 +386,6 @@ type HasSynchronousReset (dom :: Domain) = type HasAsynchronousReset (dom :: Domain) = (KnownDomain dom, DomainResetKind dom ~ 'Asynchronous) --- | Convenience type to help to extract the initial value behavior from a --- domain. Example usage: --- --- @ --- myFunc :: (KnownDomain dom, DomainInitBehavior dom ~ 'Defined) => ... --- @ -type DomainInitBehavior (dom :: Domain) = - DomainConfigurationInitBehavior (KnownConf dom) - -- | Convenience type to constrain a domain to have initial values. Example -- usage: -- @@ -443,15 +402,6 @@ type DomainInitBehavior (dom :: Domain) = type HasDefinedInitialValues (dom :: Domain) = (KnownDomain dom, DomainInitBehavior dom ~ 'Defined) --- | Convenience type to help to extract the reset polarity from a domain. --- Example usage: --- --- @ --- myFunc :: (KnownDomain dom, DomainResetPolarity dom ~ 'ActiveHigh) => ... --- @ -type DomainResetPolarity (dom :: Domain) = - DomainConfigurationResetPolarity (KnownConf dom) - -- * Time representation -- | Gets time in 'Picoseconds' from time in 'Seconds' @@ -489,9 +439,7 @@ type ClockDivider (dom :: Domain) (period :: Nat) = PeriodToCycles dom period data SDomainConfiguration (dom :: Domain) (conf :: DomainConfiguration) where SDomainConfiguration :: 1 <= period => - { sName :: SSymbol dom - -- ^ Domain name - , sPeriod :: SNat period + { sPeriod :: SNat period -- ^ Period of clock in /ps/ , sActiveEdge :: SActiveEdge edge -- ^ Active edge of the clock (not yet implemented) @@ -508,17 +456,72 @@ deriving instance Show (SDomainConfiguration dom conf) type KnownConfiguration dom conf = (KnownDomain dom, KnownConf dom ~ conf) +-- | Evidence for the active edge to be known. +class KnownActiveEdge (edge :: ActiveEdge) where + knownActiveEdge :: SActiveEdge edge +instance KnownActiveEdge Rising where knownActiveEdge = SRising +instance KnownActiveEdge Falling where knownActiveEdge = SFalling + +-- | Evidence for the reset kind to be known. +class KnownResetKind (resetKind :: ResetKind) where + knownResetKind :: SResetKind resetKind +instance KnownResetKind Asynchronous where knownResetKind = SAsynchronous +instance KnownResetKind Synchronous where knownResetKind = SSynchronous + +-- | Evidence for the init behavior to be known. +class KnownInitBehavior (init :: InitBehavior) where + knownInitBehavior :: SInitBehavior init +instance KnownInitBehavior Unknown where knownInitBehavior = SUnknown +instance KnownInitBehavior Defined where knownInitBehavior = SDefined + +-- | Evidence for the reset polarity to be known. +class KnownResetPolarity (polarity :: ResetPolarity) where + knownResetPolarity :: SResetPolarity polarity +instance KnownResetPolarity ActiveLow where knownResetPolarity = SActiveLow +instance KnownResetPolarity ActiveHigh where knownResetPolarity = SActiveHigh + +-- | The configuration parameters of a known domain given as a +-- 'DomainConfiguration'. +type KnownConf dom = 'DomainConfiguration dom + (DomainPeriod dom) + (DomainActiveEdge dom) + (DomainResetKind dom) + (DomainInitBehavior dom) + (DomainResetPolarity dom) + -- | A 'KnownDomain' constraint indicates that a circuit's behavior depends on -- some properties of a domain. See 'DomainConfiguration' for more information. -class (KnownSymbol dom, KnownNat (DomainPeriod dom)) => KnownDomain (dom :: Domain) where - type KnownConf dom :: DomainConfiguration - -- | Returns 'SDomainConfiguration' corresponding to an instance's 'DomainConfiguration'. - -- - -- Example usage: - -- - -- >>> knownDomain @System - -- SDomainConfiguration {sName = SSymbol @"System", sPeriod = SNat @10000, sActiveEdge = SRising, sResetKind = SAsynchronous, sInitBehavior = SDefined, sResetPolarity = SActiveHigh} - knownDomain :: SDomainConfiguration dom (KnownConf dom) +class + ( Typeable dom + , KnownNat (DomainPeriod dom) + , KnownNat (DomainPeriod dom - 1) + , KnownActiveEdge (DomainActiveEdge dom) + , KnownResetKind (DomainResetKind dom) + , KnownInitBehavior (DomainInitBehavior dom) + , KnownResetPolarity (DomainResetPolarity dom) + ) => + KnownDomain (dom :: Domain) + where + type DomainPeriod dom :: Nat + type DomainActiveEdge dom :: ActiveEdge + type DomainResetKind dom :: ResetKind + type DomainInitBehavior dom :: InitBehavior + type DomainResetPolarity dom :: ResetPolarity + +-- | Returns 'SDomainConfiguration' corresponding to an instance's 'KnownDomain'. +-- +-- Example usage: +-- +-- >>> knownDomain @System +-- SDomainConfiguration {sName = SSymbol @"System", sPeriod = SNat @10000, sActiveEdge = SRising, sResetKind = SAsynchronous, sInitBehavior = SDefined, sResetPolarity = SActiveHigh} +knownDomain :: KnownDomain dom => SDomainConfiguration dom (KnownConf dom) +knownDomain = SDomainConfiguration + { sPeriod = SNat + , sActiveEdge = knownActiveEdge + , sResetKind = knownResetKind + , sInitBehavior = knownInitBehavior + , sResetPolarity = knownResetPolarity + } -- | Version of 'knownDomain' that takes a 'SSymbol'. For example: -- @@ -527,7 +530,7 @@ class (KnownSymbol dom, KnownNat (DomainPeriod dom)) => KnownDomain (dom :: Doma knownDomainByName :: forall dom . KnownDomain dom - => SSymbol dom + => Proxy dom -> SDomainConfiguration dom (KnownConf dom) knownDomainByName = const knownDomain @@ -535,18 +538,27 @@ knownDomainByName = -- | A /clock/ (and /reset/) dom with clocks running at 100 MHz instance KnownDomain System where - type KnownConf System = 'DomainConfiguration System 10000 'Rising 'Asynchronous 'Defined 'ActiveHigh - knownDomain = SDomainConfiguration SSymbol SNat SRising SAsynchronous SDefined SActiveHigh + type DomainPeriod System = 10000 + type DomainActiveEdge System = 'Rising + type DomainResetKind System = 'Asynchronous + type DomainInitBehavior System = 'Defined + type DomainResetPolarity System = 'ActiveHigh -- | System instance with defaults set for Xilinx FPGAs instance KnownDomain XilinxSystem where - type KnownConf XilinxSystem = 'DomainConfiguration XilinxSystem 10000 'Rising 'Synchronous 'Defined 'ActiveHigh - knownDomain = SDomainConfiguration SSymbol SNat SRising SSynchronous SDefined SActiveHigh + type DomainPeriod XilinxSystem = 10000 + type DomainActiveEdge XilinxSystem = 'Rising + type DomainResetKind XilinxSystem = 'Synchronous + type DomainInitBehavior XilinxSystem = 'Defined + type DomainResetPolarity XilinxSystem = 'ActiveHigh -- | System instance with defaults set for Intel FPGAs instance KnownDomain IntelSystem where - type KnownConf IntelSystem = 'DomainConfiguration IntelSystem 10000 'Rising 'Asynchronous 'Defined 'ActiveHigh - knownDomain = SDomainConfiguration SSymbol SNat SRising SAsynchronous SDefined SActiveHigh + type DomainPeriod IntelSystem = 10000 + type DomainActiveEdge IntelSystem = 'Rising + type DomainResetKind IntelSystem = 'Asynchronous + type DomainInitBehavior IntelSystem = 'Defined + type DomainResetPolarity IntelSystem = 'ActiveHigh -- | Convenience value to allow easy "subclassing" of System domain. Should -- be used in combination with 'createDomain'. For example, if you just want to @@ -563,8 +575,7 @@ vSystem = vDomain (knownDomain @System) -- -- See module documentation of "Clash.Explicit.Signal" for more information on -- how to create custom synthesis domains. -type System = ("System" :: Domain) - +data System -- | Convenience value to allow easy "subclassing" of IntelSystem domain. Should -- be used in combination with 'createDomain'. For example, if you just want to @@ -581,7 +592,7 @@ vIntelSystem = vDomain (knownDomain @IntelSystem) -- -- See module documentation of "Clash.Explicit.Signal" for more information on -- how to create custom synthesis domains. -type IntelSystem = ("IntelSystem" :: Domain) +data IntelSystem -- | Convenience value to allow easy "subclassing" of XilinxSystem domain. Should -- be used in combination with 'createDomain'. For example, if you just want to @@ -598,7 +609,7 @@ vXilinxSystem = vDomain (knownDomain @XilinxSystem) -- -- See module documentation of "Clash.Explicit.Signal" for more information on -- how to create custom synthesis domains. -type XilinxSystem = ("XilinxSystem" :: Domain) +data XilinxSystem -- | Same as SDomainConfiguration but allows for easy updates through record update syntax. -- Should be used in combination with 'vDomain' and 'createDomain'. Example: @@ -630,10 +641,14 @@ data VDomainConfiguration -- | Convert 'SDomainConfiguration' to 'VDomainConfiguration'. Should be used in combination with -- 'createDomain' only. -vDomain :: SDomainConfiguration dom conf -> VDomainConfiguration -vDomain (SDomainConfiguration dom period edge reset init_ polarity) = +vDomain :: + forall dom conf. + Typeable dom => + SDomainConfiguration dom conf -> + VDomainConfiguration +vDomain (SDomainConfiguration period edge reset init_ polarity) = VDomainConfiguration - (ssymbolToString dom) + (show (typeRep @dom)) (snatToNatural period) (case edge of {SRising -> Rising; SFalling -> Falling}) (case reset of {SAsynchronous -> Asynchronous; SSynchronous -> Synchronous}) @@ -679,12 +694,18 @@ createDomain :: VDomainConfiguration -> Q [Dec] createDomain (VDomainConfiguration name period edge reset init_ polarity) = if isValidDomainName name then do kdType <- [t| KnownDomain $nameT |] - kcType <- [t| ('DomainConfiguration $nameT $periodT $edgeT $resetKindT $initT $polarityT) |] - sDom <- [| SDomainConfiguration SSymbol SNat $edgeE $resetKindE $initE $polarityE |] - - let vNameImpl = AppE (VarE 'vDomain) (AppTypeE (VarE 'knownDomain) (LitT (StrTyLit name))) - kdImpl = FunD 'knownDomain [Clause [] (NormalB sDom) []] - kcImpl = mkTySynInstD ''KnownConf [LitT (StrTyLit name)] kcType + kpType <- [t| $periodT |] + keType <- [t| $edgeT |] + krType <- [t| $resetKindT |] + kiType <- [t| $initT |] + koType <- [t| $polarityT |] + + let vNameImpl = AppE (VarE 'vDomain) (AppTypeE (VarE 'knownDomain) (ConT name')) + kpImpl = mkTySynInstD ''DomainPeriod [ConT name'] kpType + keImpl = mkTySynInstD ''DomainActiveEdge [ConT name'] keType + krImpl = mkTySynInstD ''DomainResetKind [ConT name'] krType + kiImpl = mkTySynInstD ''DomainInitBehavior [ConT name'] kiType + koImpl = mkTySynInstD ''DomainResetPolarity [ConT name'] koType vName' = mkName ('v':name) tySynExists <- isJust <$> lookupTypeName name @@ -692,8 +713,8 @@ createDomain (VDomainConfiguration name period edge reset init_ polarity) = pure $ concat [ - [ -- Type synonym (ex: type System = "System") - TySynD (mkName name) [] (LitT (StrTyLit name) `SigT` ConT ''Domain) + [ -- Type declaration (ex: data System :: Domain) + DataD [] name' [] (Just (ConT ''Domain)) [] [] | not tySynExists ] @@ -705,39 +726,15 @@ createDomain (VDomainConfiguration name period edge reset init_ polarity) = | not vHelperExists ] , [ -- KnownDomain instance (ex: instance KnownDomain "System" where ...) - InstanceD Nothing [] kdType [kcImpl, kdImpl] + InstanceD Nothing [] kdType [kpImpl, keImpl, krImpl, kiImpl, koImpl] ] ] else error ("Domain names should be a valid Haskell type name, not: " ++ name) where - - edgeE = - pure $ - case edge of - Rising -> ConE 'SRising - Falling -> ConE 'SFalling - - resetKindE = - pure $ - case reset of - Asynchronous -> ConE 'SAsynchronous - Synchronous -> ConE 'SSynchronous - - initE = - pure $ - case init_ of - Unknown -> ConE 'SUnknown - Defined -> ConE 'SDefined - - polarityE = - pure $ - case polarity of - ActiveHigh -> ConE 'SActiveHigh - ActiveLow -> ConE 'SActiveLow - - nameT = pure (LitT (StrTyLit name)) + name' = mkName name + nameT = pure (ConT name') periodT = pure (LitT (NumTyLit (toInteger period))) edgeT = @@ -765,7 +762,7 @@ createDomain (VDomainConfiguration name period edge reset init_ polarity) = ActiveLow -> PromotedT 'ActiveLow -type Domain = Symbol +type Domain = Type -- | We either get evidence that this function was instantiated with the same -- domains, or Nothing. @@ -773,7 +770,7 @@ sameDomain :: forall (domA :: Domain) (domB :: Domain) . (KnownDomain domA, KnownDomain domB) => Maybe (domA :~: domB) -sameDomain = sameSymbol (Proxy @domA) (Proxy @domB) +sameDomain = testEquality (typeRep @domA) (typeRep @domB) infixr 5 :- {- | Clash has synchronous 'Signal's in the form of: @@ -974,26 +971,23 @@ enableGen = toEnable (pure True) -- | A clock signal belonging to a domain named /dom/. data Clock (dom :: Domain) = Clock - { -- | Domain associated with the clock - clockTag :: SSymbol dom - - -- | Periods of the clock. This is an experimental feature used to simulate + { -- | Periods of the clock. This is an experimental feature used to simulate -- clock frequency correction mechanisms. Currently, all ways to contruct -- such a clock are hidden from the public API. - , clockPeriods :: Maybe (Signal dom Femtoseconds) + clockPeriods :: Maybe (Signal dom Femtoseconds) } -instance Show (Clock dom) where - show (Clock dom Nothing) = "" - show (Clock dom _) = "" +instance Typeable dom => Show (Clock dom) where + show (Clock Nothing) = "" + show (Clock _) = "" -- | The negative or inverted phase of a differential clock signal. HDL -- generation will treat it the same as 'Clock', except that no @create_clock@ -- command is issued in the SDC file for 'ClockN'. Used in 'DiffClock'. -newtype ClockN (dom :: Domain) = ClockN { clockNTag :: SSymbol dom } +newtype ClockN (dom :: Domain) = ClockN { clockNTag :: Proxy dom } -instance Show (ClockN dom) where - show (ClockN dom) = "" +instance Typeable dom => Show (ClockN dom) where + show (ClockN _) = "" -- | A differential clock signal belonging to a domain named /dom/. The clock -- input of a design with such an input has two ports which are in antiphase. @@ -1006,11 +1000,11 @@ instance Show (ClockN dom) where data DiffClock (dom :: Domain) = DiffClock ("p" ::: Clock dom) ("n" ::: ClockN dom) -instance Show (DiffClock dom) where - show (DiffClock (Clock dom Nothing) _) = - "" - show (DiffClock (Clock dom _) _) = - "" +instance Typeable dom => Show (DiffClock dom) where + show (DiffClock (Clock Nothing) _) = + "" + show (DiffClock (Clock _) _) = + "" -- | Clock generator for simulations. Do __not__ use this clock generator for -- the /testBench/ function, use 'tbClockGen' instead. @@ -1078,7 +1072,7 @@ tbClockGen :: KnownDomain testDom => Signal testDom Bool -> Clock testDom -tbClockGen done = Clock (done `seq` SSymbol) Nothing +tbClockGen done = Clock (done `seq` Nothing) {-# OPAQUE tbClockGen #-} {-# ANN tbClockGen hasBlackBox #-} @@ -1156,7 +1150,7 @@ tbDynamicClockGen :: Signal dom Bool -> Clock dom tbDynamicClockGen periods ena = - Clock (ena `seq` periods `seq` SSymbol) (Just periods) + Clock (ena `seq` periods `seq` Just periods) {-# OPAQUE tbDynamicClockGen #-} {-# ANN tbDynamicClockGen hasBlackBox #-} @@ -1223,7 +1217,7 @@ resetPolarityProxy -> SResetPolarity polarity resetPolarityProxy _proxy = case knownDomain @dom of - SDomainConfiguration _dom _period _edge _sync _init polarity -> + SDomainConfiguration _period _edge _sync _init polarity -> polarity -- | Convert a reset to an active high reset. Has no effect if reset is already @@ -1508,16 +1502,16 @@ delay# -> a -> Signal dom a -> Signal dom a -delay# (Clock dom _) (fromEnable -> en) powerUpVal0 = +delay# (Clock _) (fromEnable -> en) powerUpVal0 = go powerUpVal1 en where powerUpVal1 :: a powerUpVal1 = - case knownDomainByName dom of - SDomainConfiguration _dom _period _edge _sync SDefined _polarity -> + case knownDomainByName (Proxy @dom) of + SDomainConfiguration _period _edge _sync SDefined _polarity -> powerUpVal0 - SDomainConfiguration _dom _period _edge _sync SUnknown _polarity -> - deepErrorX ("First value of `delay` unknown on domain " ++ show dom) + SDomainConfiguration _period _edge _sync SUnknown _polarity -> + deepErrorX ("First value of `delay` unknown on domain " ++ show (typeRep @dom)) go o (e :- es) as@(~(x :- xs)) = let o' = if e then x else o @@ -1550,11 +1544,11 @@ register# -- ^ Reset value -> Signal dom a -> Signal dom a -register# clk@(Clock dom _) rst ena powerUpVal resetVal = - case knownDomainByName dom of - SDomainConfiguration _name _period _edge SSynchronous _init _polarity -> +register# clk@(Clock _) rst ena powerUpVal resetVal = + case knownDomainByName (Proxy @dom) of + SDomainConfiguration _period _edge SSynchronous _init _polarity -> syncRegister# clk rst ena powerUpVal resetVal - SDomainConfiguration _name _period _edge SAsynchronous _init _polarity -> + SDomainConfiguration _period _edge SAsynchronous _init _polarity -> asyncRegister# clk rst ena powerUpVal resetVal {-# OPAQUE register# #-} {-# ANN register# hasBlackBox #-} @@ -1569,11 +1563,11 @@ registerPowerup# => Clock dom -> a -> a -registerPowerup# (Clock dom _) a = - case knownDomainByName dom of - SDomainConfiguration _dom _period _edge _sync SDefined _polarity -> a - SDomainConfiguration _dom _period _edge _sync SUnknown _polarity -> - deepErrorX ("First value of register undefined on domain " ++ show dom) +registerPowerup# (Clock _) a = + case knownDomainByName (Proxy @dom) of + SDomainConfiguration _period _edge _sync SDefined _polarity -> a + SDomainConfiguration _period _edge _sync SUnknown _polarity -> + deepErrorX ("First value of register undefined on domain " ++ show (typeRep @dom)) -- | Version of 'register#' that simulates a register on an asynchronous -- domain. Is synthesizable. @@ -2149,7 +2143,7 @@ clockTicks clkA clkB = clockTicksEither (toEither clkA) (toEither clkB) KnownDomain dom => Clock dom -> Either Int64 (Signal dom Int64) - toEither (Clock _ maybePeriods) + toEither (Clock maybePeriods) | Just periods <- maybePeriods = Right (unFemtosecondsSignal periods) | SDomainConfiguration{sPeriod} <- knownDomain @dom = diff --git a/clash-prelude/src/Clash/Signal/Trace.hs b/clash-prelude/src/Clash/Signal/Trace.hs index a36a03694c..ac56c2c573 100644 --- a/clash-prelude/src/Clash/Signal/Trace.hs +++ b/clash-prelude/src/Clash/Signal/Trace.hs @@ -102,7 +102,7 @@ module Clash.Signal.Trace import Clash.Annotations.Primitive (hasBlackBox) import Clash.Signal.Internal (fromList) import Clash.Signal - (KnownDomain(..), SDomainConfiguration(..), Signal, bundle, unbundle) + (KnownDomain, SDomainConfiguration(..), Signal, knownDomain, bundle, unbundle) import Clash.Sized.Vector (Vec, iterateI) import qualified Clash.Sized.Vector as Vector import Clash.Class.BitPack (BitPack, BitSize, pack, unpack) diff --git a/clash-prelude/tests/Clash/Tests/AsyncFIFOSynchronizer.hs b/clash-prelude/tests/Clash/Tests/AsyncFIFOSynchronizer.hs index 19220d3877..50472fad5e 100644 --- a/clash-prelude/tests/Clash/Tests/AsyncFIFOSynchronizer.hs +++ b/clash-prelude/tests/Clash/Tests/AsyncFIFOSynchronizer.hs @@ -9,6 +9,7 @@ module Clash.Tests.AsyncFIFOSynchronizer (tests) where import Data.Maybe (isJust, catMaybes) import qualified Prelude as P +import Type.Reflection (typeRep) import Hedgehog as H import qualified Hedgehog.Range as Range @@ -983,8 +984,8 @@ data DomProxy (dom :: Domain) where -- A more useful Show instance than the one for 'Proxy' instance Show (DomProxy dom) where - showsPrec d dom@DomProxy = - showParen (d > app_prec) $ ("DomProxy @" <>) . (symbolVal dom <>) + showsPrec d DomProxy = + showParen (d > app_prec) $ ("DomProxy @" <>) . (show (typeRep @dom) <>) where app_prec = 10 data NamedTest a = NamedTest diff --git a/clash-prelude/tests/Clash/Tests/Reset.hs b/clash-prelude/tests/Clash/Tests/Reset.hs index 53f08c01c0..260a8b23fb 100644 --- a/clash-prelude/tests/Clash/Tests/Reset.hs +++ b/clash-prelude/tests/Clash/Tests/Reset.hs @@ -15,7 +15,6 @@ import Clash.Explicit.Prelude import qualified Prelude as P -- Testing with explicit declaration of the Low type alias -type Low = ("Low" :: Domain) createDomain vSystem{vName="Low", vResetPolarity=ActiveLow} sampleResetN :: KnownDomain dom => Int -> Reset dom -> [Bool]