Add ExtractClockDom and ExtractResetDom

leonschoorl · leonschoorl · commit 3c9eaf2dc66d · 2023-10-13T00:39:23.000+02:00
diff --git a/clash-cores/src/Clash/Cores/Xilinx/BlockRam.hs b/clash-cores/src/Clash/Cores/Xilinx/BlockRam.hs
@@ -14,7 +14,6 @@
 module Clash.Cores.Xilinx.BlockRam (tdpbram) where
 
 import Clash.Explicit.Prelude
-import Clash.Signal.Internal (Clock(Clock))
 
 import GHC.Stack (HasCallStack)
 
@@ -60,7 +59,7 @@ tdpbram ::
   ( Signal domA a
   , Signal domB a
   )
-tdpbram clkA@(Clock{}) enA addrA byteEnaA datA clkB@(Clock{}) enB addrB byteEnaB datB =
+tdpbram clkA@ExtractClockDom enA addrA byteEnaA datA clkB@ExtractClockDom enB addrB byteEnaB datB =
   -- [Note: eta port names for tdpbram]
   --
   -- By naming all the arguments and setting the -fno-do-lambda-eta-expansion GHC
diff --git a/clash-cores/src/Clash/Cores/Xilinx/DcFifo.hs b/clash-cores/src/Clash/Cores/Xilinx/DcFifo.hs
@@ -71,7 +71,7 @@ module Clash.Cores.Xilinx.DcFifo
   ) where
 
 import Clash.Explicit.Prelude
-import Clash.Signal.Internal (Clock(..), Signal (..), ClockAB (..), clockTicks)
+import Clash.Signal.Internal (Signal (..), ClockAB (..), clockTicks)
 import Data.Maybe (isJust)
 import qualified Data.Sequence as Seq
 import Data.Sequence (Seq)
@@ -153,7 +153,7 @@ dcFifo ::
   -- | Read enable @rd_en@
   Signal read Bool ->
   FifoOut read write depth a
-dcFifo DcConfig{..} wClk@(Clock{}) wRst rClk@(Clock{}) rRst writeData rEnable =
+dcFifo DcConfig{..} wClk@ExtractClockDom wRst rClk@ExtractClockDom rRst writeData rEnable =
   case (resetKind @write, resetKind @read) of
     (SSynchronous, SSynchronous) ->
       let
diff --git a/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/ArraySingle.hs b/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/ArraySingle.hs
@@ -12,7 +12,6 @@ module Clash.Cores.Xilinx.Xpm.Cdc.ArraySingle
   ) where
 
 import Clash.Explicit.Prelude
-import Clash.Signal.Internal (Clock(Clock))
 
 import GHC.Stack (HasCallStack)
 
@@ -41,7 +40,7 @@ xpmCdcArraySingle ::
   Clock dst ->
   Signal src a ->
   Signal dst a
-xpmCdcArraySingle clkSrc@(Clock{}) clkDst@(Clock{}) = xpmCdcArraySingleWith XpmCdcArraySingleConfig{..} clkSrc clkDst
+xpmCdcArraySingle clkSrc@ExtractClockDom clkDst@ExtractClockDom = xpmCdcArraySingleWith XpmCdcArraySingleConfig{..} clkSrc clkDst
  where
   registerInput = True
   stages = d4
diff --git a/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/Gray.hs b/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/Gray.hs
@@ -15,7 +15,6 @@ module Clash.Cores.Xilinx.Xpm.Cdc.Gray
 import GHC.Stack (HasCallStack)
 
 import Clash.Explicit.Prelude
-import Clash.Signal.Internal (Clock(Clock))
 
 import Clash.Cores.Xilinx.Xpm.Cdc.Gray.Internal (xpmCdcGray#)
 
@@ -53,7 +52,7 @@ xpmCdcGray ::
   Clock dst ->
   Signal src (Unsigned n) ->
   Signal dst (Unsigned n)
-xpmCdcGray clkSrc@(Clock{}) clkDst@(Clock{}) = xpmCdcGrayWith XpmCdcGrayConfig{..}  clkSrc clkDst
+xpmCdcGray clkSrc@ExtractClockDom clkDst@ExtractClockDom = xpmCdcGrayWith XpmCdcGrayConfig{..}  clkSrc clkDst
  where
   stages = d4
   initialValues =
diff --git a/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/Handshake.hs b/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/Handshake.hs
@@ -12,7 +12,6 @@ module Clash.Cores.Xilinx.Xpm.Cdc.Handshake
   ) where
 
 import Clash.Explicit.Prelude
-import Clash.Signal.Internal (Clock(Clock))
 
 import GHC.Stack (HasCallStack)
 
@@ -66,7 +65,7 @@ xpmCdcHandshake ::
   , "dest_req" ::: Signal dst Bool
   , "src_rcv"  ::: Signal src Bool
   )
-xpmCdcHandshake clkSrc@(Clock{}) clkDst@(Clock{}) = xpmCdcHandshakeWith XpmCdcHandshakeConfig{..} clkSrc clkDst
+xpmCdcHandshake clkSrc@ExtractClockDom clkDst@ExtractClockDom = xpmCdcHandshakeWith XpmCdcHandshakeConfig{..} clkSrc clkDst
  where
   srcStages = d4
   dstStages = d4
diff --git a/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/Single.hs b/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/Single.hs
@@ -12,7 +12,6 @@ module Clash.Cores.Xilinx.Xpm.Cdc.Single
   ) where
 
 import Clash.Explicit.Prelude
-import Clash.Signal.Internal (Clock(Clock))
 
 import GHC.Stack (HasCallStack)
 
@@ -40,7 +39,7 @@ xpmCdcSingle ::
   Clock dst ->
   Signal src a ->
   Signal dst a
-xpmCdcSingle  clkSrc@(Clock{}) clkDst@(Clock{}) = xpmCdcSingleWith XpmCdcSingleConfig{..}  clkSrc clkDst
+xpmCdcSingle  clkSrc@ExtractClockDom clkDst@ExtractClockDom = xpmCdcSingleWith XpmCdcSingleConfig{..}  clkSrc clkDst
  where
   registerInput = True
   stages = d4
diff --git a/clash-prelude/src/Clash/Explicit/RAM.hs b/clash-prelude/src/Clash/Explicit/RAM.hs
@@ -139,7 +139,7 @@ asyncRam#
   -- ^ Value to write (at address @w@)
   -> Signal rdom a
   -- ^ Value of the RAM at address @r@
-asyncRam# wClk@(Clock{}) rClk@(Clock{}) en sz rd we wr din = dout
+asyncRam# wClk@ExtractClockDom rClk@ExtractClockDom en sz rd we wr din = dout
   where
     ramI = Seq.replicate
               szI
diff --git a/clash-prelude/src/Clash/Explicit/Reset.hs b/clash-prelude/src/Clash/Explicit/Reset.hs
@@ -84,7 +84,7 @@ orReset = unsafeOrReset
 -- domains with components with asynchronous resets, where use of this function
 -- can introduce glitches triggering a reset.
 unsafeOrReset :: forall dom. Reset dom -> Reset dom -> Reset dom
-unsafeOrReset r0@(Reset{}) r1 =
+unsafeOrReset r0@ExtractResetDom r1 =
   unsafeToReset $
     case resetPolarity @dom of
       SActiveHigh -> rst0 .||. rst1
@@ -107,7 +107,7 @@ andReset = unsafeAndReset
 -- components with asynchronous resets, where use of this function can introduce
 -- glitches triggering a reset.
 unsafeAndReset :: forall dom. Reset dom -> Reset dom -> Reset dom
-unsafeAndReset r0@(Reset{}) r1 =
+unsafeAndReset r0@ExtractResetDom r1 =
   unsafeToReset $
     case resetPolarity @dom of
       SActiveHigh -> rst0 .&&. rst1
@@ -221,7 +221,7 @@ resetSynchronizer
    . Clock dom
   -> Reset dom
   -> Reset dom
-resetSynchronizer clk@(Clock{}) rst = rstOut
+resetSynchronizer clk@ExtractClockDom rst = rstOut
  where
   isActiveHigh = case resetPolarity @dom of { SActiveHigh -> True; _ -> False }
   rstOut =
@@ -316,7 +316,7 @@ unsafeResetGlitchFilter
   -> Clock dom
   -> Reset dom
   -> Reset dom
-unsafeResetGlitchFilter glitchlessPeriod clk@(Clock{}) =
+unsafeResetGlitchFilter glitchlessPeriod clk@ExtractClockDom =
   resetGlitchFilter# glitchlessPeriod reg dffSync
  where
   reg = delay clk enableGen
@@ -377,7 +377,7 @@ resetGlitchFilter#
      )
   -> Reset dom
   -> Reset dom
-resetGlitchFilter# SNat reg dffSync rstIn0@(Reset{}) =
+resetGlitchFilter# SNat reg dffSync rstIn0@ExtractResetDom =
   let s' = go <$> s <*> rstIn2
       s  = reg (asserted, 0) s'
   in unsafeToReset $ fst <$> s
@@ -427,7 +427,7 @@ holdReset
   -> Reset dom
   -- ^ Reset to extend
   -> Reset dom
-holdReset clk en SNat rst@(Reset{}) =
+holdReset clk en SNat rst@ExtractResetDom =
   unsafeFromActiveHigh ((/=maxBound) <$> counter)
  where
   counter :: Signal dom (Index (n+1))
@@ -445,7 +445,7 @@ convertReset
   -> Clock domB
   -> Reset domA
   -> Reset domB
-convertReset clkA@(Clock{}) clkB@(Clock{}) rstA0 = rstB1
+convertReset clkA@ExtractClockDom clkB@ExtractClockDom rstA0 = rstB1
  where
   rstA1 = unsafeFromReset rstA0
   rstA2 =
diff --git a/clash-prelude/src/Clash/Explicit/Signal.hs b/clash-prelude/src/Clash/Explicit/Signal.hs
@@ -203,15 +203,15 @@ module Clash.Explicit.Signal
   , fromEnable
   , enableGen
     -- * Clock
-  , Clock
+  , Clock(ExtractClockDom)
   , DiffClock
   , periodToHz
   , hzToPeriod
     -- ** Synchronization primitive
   , unsafeSynchronizer
   , veryUnsafeSynchronizer
     -- * Reset
-  , Reset
+  , Reset(ExtractResetDom)
   , unsafeToReset
   , unsafeFromReset
   , unsafeToActiveHigh
diff --git a/clash-prelude/src/Clash/Explicit/Testbench.hs b/clash-prelude/src/Clash/Explicit/Testbench.hs
@@ -468,7 +468,7 @@ seClockToDiffClock ::
   Clock dom ->
   -- | Differential output
   DiffClock dom
-seClockToDiffClock clk@(Clock{}) = DiffClock clk (ClockN SSymbol)
+seClockToDiffClock clk@ExtractClockDom = DiffClock clk (ClockN SSymbol)
 -- See: https://github.com/clash-lang/clash-compiler/pull/2511
 {-# CLASH_OPAQUE seClockToDiffClock #-}
 {-# ANN seClockToDiffClock hasBlackBox #-}
diff --git a/clash-prelude/src/Clash/Signal.hs b/clash-prelude/src/Clash/Signal.hs
@@ -131,7 +131,7 @@ module Clash.Signal
   , initBehavior
   , resetPolarity
     -- * Clock
-  , Clock
+  , Clock(ExtractClockDom)
   , DiffClock
   , periodToHz
   , hzToPeriod
@@ -140,7 +140,7 @@ module Clash.Signal
   , unsafeSynchronizer
 #endif
     -- * Reset
-  , Reset
+  , Reset(ExtractResetDom)
   , unsafeToReset
   , unsafeFromReset
   , unsafeToActiveHigh
diff --git a/clash-prelude/src/Clash/Signal/Internal.hs b/clash-prelude/src/Clash/Signal/Internal.hs
@@ -88,7 +88,7 @@ module Clash.Signal.Internal
   , createDomain
   , HasKnownDomain(..)
     -- * Clocks
-  , Clock (..)
+  , Clock (..,ExtractClockDom)
   , ClockN (..)
   , DiffClock (..)
   , hzToPeriod
@@ -102,7 +102,7 @@ module Clash.Signal.Internal
   , fromEnable
   , enableGen
     -- * Resets
-  , Reset(..)
+  , Reset(..,ExtractResetDom)
   , unsafeToReset
   , unsafeFromReset
   , unsafeToActiveHigh
@@ -939,6 +939,13 @@ data Clock (dom :: Domain) = KnownDomain dom => Clock
   , clockPeriods :: Maybe (Signal dom Femtoseconds)
   }
 
+pattern ExtractClockDom
+  :: ()              -- contraint required to match the pattern
+  => KnownDomain dom -- contraint provided by matching the pattern
+  => Clock dom
+pattern ExtractClockDom <- Clock {}
+{-# COMPLETE ExtractClockDom #-}
+
 instance Show (Clock dom) where
   show (Clock dom Nothing) = "<Clock: " ++ ssymbolToString dom ++ ">"
   show (Clock dom _) = "<Dynamic clock: " ++ ssymbolToString dom ++ ">"
@@ -1172,6 +1179,13 @@ resetGenN n =
 data Reset (dom :: Domain) where
   Reset :: KnownDomain dom => Signal dom Bool -> Reset dom
 
+pattern ExtractResetDom
+  :: ()              -- contraint required to match the pattern
+  => KnownDomain dom -- contraint provided by matching the pattern
+  => Reset dom
+pattern ExtractResetDom <- Reset {}
+{-# COMPLETE ExtractResetDom #-}
+
 -- | Non-ambiguous version of 'Clash.Signal.Internal.Ambiguous.resetPolarity'
 resetPolarityProxy
   :: forall dom proxy polarity
@@ -1196,7 +1210,7 @@ unsafeToActiveHigh
   :: forall dom
    . Reset dom
   -> Signal dom Bool
-unsafeToActiveHigh r0@(Reset{}) =
+unsafeToActiveHigh r0@ExtractResetDom =
   case resetPolarityProxy (Proxy @dom) of
     SActiveHigh -> r
     SActiveLow -> not <$> r
@@ -1234,7 +1248,7 @@ unsafeToActiveLow
   :: forall dom
    . Reset dom
   -> Signal dom Bool
-unsafeToActiveLow r0@(Reset{}) =
+unsafeToActiveLow r0@ExtractResetDom =
   case resetPolarityProxy (Proxy @dom) of
     SActiveHigh -> not <$> r
     SActiveLow -> r
@@ -1298,13 +1312,13 @@ class HasKnownDomain a where
   provideKnownDomainFrom :: a dom -> (KnownDomain dom => r) -> r
 
 instance HasKnownDomain Clock where
-  provideKnownDomainFrom (Clock{}) f = f
+  provideKnownDomainFrom ExtractClockDom f = f
 
 instance HasKnownDomain DiffClock where
   provideKnownDomainFrom (DiffClock clkP _) = provideKnownDomainFrom clkP
 
 instance HasKnownDomain Reset where
-  provideKnownDomainFrom (Reset{}) f = f
+  provideKnownDomainFrom ExtractResetDom f = f
 
 
 -- | Interpret a signal of bools as an active high reset and convert it to
@@ -1381,7 +1395,7 @@ unsafeFromActiveLow r =
 
 -- | Invert reset signal
 invertReset :: Reset dom -> Reset dom
-invertReset r@(Reset{}) = unsafeToReset . fmap not . unsafeFromReset $ r -- TODO does this synthesize?
+invertReset r@ExtractResetDom = unsafeToReset . fmap not . unsafeFromReset $ r -- TODO does this synthesize?
 
 infixr 2 .||.
 -- | The above type is a generalization for:
@@ -1518,7 +1532,7 @@ asyncRegister#
   -- ^ Reset value
   -> Signal dom a
   -> Signal dom a
-asyncRegister# clk@(Clock{}) (unsafeToActiveHigh -> rst) (fromEnable -> ena) initVal resetVal =
+asyncRegister# clk@ExtractClockDom (unsafeToActiveHigh -> rst) (fromEnable -> ena) initVal resetVal =
   go (registerPowerup# clk initVal) rst ena
  where
   go o (r :- rs) enas@(~(e :- es)) as@(~(x :- xs)) =
