diff --git a/changelog/2023-07-13T14_49_23+02_00_rename_from_polarity b/changelog/2023-07-13T14_49_23+02_00_rename_from_polarity new file mode 100644 index 0000000000..c04f76e618 --- /dev/null +++ b/changelog/2023-07-13T14_49_23+02_00_rename_from_polarity @@ -0,0 +1 @@ +DEPRECATED: `unsafeFromLowPolarity` and `unsafeFromHighPolarity` have been replaced by `unsafeFromActiveLow` and `unsafeFromActiveHigh`. While former ones will continue to exist, a deprecation warning has been added pointing to the latter ones. diff --git a/clash-cores/test/Test/Cores/Xilinx/DcFifo.hs b/clash-cores/test/Test/Cores/Xilinx/DcFifo.hs index a389e03933..e8e196c54d 100644 --- a/clash-cores/test/Test/Cores/Xilinx/DcFifo.hs +++ b/clash-cores/test/Test/Cores/Xilinx/DcFifo.hs @@ -260,7 +260,7 @@ testOverflow = testCase "Overflows appropriately" $ do fifo = dcFifo @4 defConfig{dcOverflow = True} clk noRst clk noRst clk = clockGen @D3 - noRst = unsafeFromHighPolarity $ pure False + noRst = unsafeFromActiveHigh $ pure False drive15 = mealy clk noRst enableGen go 15 (pure ()) go 0 _ = (0 :: Int, Nothing) go n _ = (n-1, Just (1 :: Int)) @@ -361,11 +361,11 @@ throughFifo d _ _ feed drain wrDataList rdStalls = rdDataList where wrClk = clockGen @write - noWrRst = unsafeFromHighPolarity $ pure False + noWrRst = unsafeFromActiveHigh $ pure False wrEna = enableGen @write rdClk = clockGen @read - noRdRst = unsafeFromHighPolarity $ pure False + noRdRst = unsafeFromActiveHigh $ pure False rdEna = enableGen @read wrData = diff --git a/clash-prelude/src/Clash/Annotations/TopEntity.hs b/clash-prelude/src/Clash/Annotations/TopEntity.hs index 9eda1dcf2b..61c769a599 100644 --- a/clash-prelude/src/Clash/Annotations/TopEntity.hs +++ b/clash-prelude/src/Clash/Annotations/TopEntity.hs @@ -84,8 +84,8 @@ topEntity clk20 rstBtn enaBtn modeBtn = -- Signal coming from the reset button is low when pressed, and high when -- not pressed. We convert this signal to the polarity of our domain with - -- /unsafeFromLowPolarity/. - rst = 'Clash.Signal.unsafeFromLowPolarity' ('Clash.Signal.unsafeFromReset' rstBtn) + -- /unsafeFromActiveLow/. + rst = 'Clash.Signal.unsafeFromActiveLow' ('Clash.Signal.unsafeFromReset' rstBtn) -- Instantiate a PLL: this stabilizes the incoming clock signal and indicates -- when the signal is stable. We're also using it to transform an incoming @@ -99,11 +99,11 @@ topEntity clk20 rstBtn enaBtn modeBtn = -- Synchronize reset to clock signal coming from PLL. We want the reset to -- remain active while the PLL is NOT stable, hence the conversion with - -- /unsafeFromLowPolarity/ + -- /unsafeFromActiveLow/ rstSync = 'Clash.Prelude.resetSynchronizer' clk50 - ('Clash.Signal.unsafeFromLowPolarity' pllStable) + ('Clash.Signal.unsafeFromActiveLow' pllStable) blinkerT :: (BitVector 8, Bool, Index 16650001) diff --git a/clash-prelude/src/Clash/Explicit/Reset.hs b/clash-prelude/src/Clash/Explicit/Reset.hs index 47aceb806b..0676fe8ce8 100644 --- a/clash-prelude/src/Clash/Explicit/Reset.hs +++ b/clash-prelude/src/Clash/Explicit/Reset.hs @@ -32,6 +32,10 @@ module Clash.Explicit.Reset , unsafeFromReset , unsafeToHighPolarity , unsafeToLowPolarity + , unsafeFromActiveHigh + , unsafeFromActiveLow + + -- * Deprecated , unsafeFromHighPolarity , unsafeFromLowPolarity ) where @@ -185,7 +189,7 @@ resetSynchronizer clk rst = rstOut -- -- === __Example 1__ -- >>> let sampleResetN n = sampleN n . unsafeToHighPolarity --- >>> let resetFromList = unsafeFromHighPolarity . fromList +-- >>> let resetFromList = unsafeFromActiveHigh . fromList -- >>> let rst = resetFromList [True, True, False, False, True, False, False, True, True, False, True, True] -- >>> sampleResetN 12 (resetGlitchFilter d2 systemClockGen rst) -- [True,True,True,True,False,False,False,False,False,True,True,True] @@ -239,7 +243,7 @@ resetGlitchFilter SNat clk rst = -- intermediate assertions of the reset signal: -- -- >>> let rst = fromList [True, False, False, False, True, False, False, False] --- >>> sampleWithReset (holdReset @System clockGen enableGen (SNat @2) (unsafeFromHighPolarity rst)) +-- >>> sampleWithReset (holdReset @System clockGen enableGen (SNat @2) (unsafeFromActiveHigh rst)) -- [True,True,True,False,True,True,True,False] -- holdReset @@ -255,7 +259,7 @@ holdReset -- ^ Reset to extend -> Reset dom holdReset clk en SNat rst = - unsafeFromHighPolarity ((/=maxBound) <$> counter) + unsafeFromActiveHigh ((/=maxBound) <$> counter) where counter :: Signal dom (Index (n+1)) counter = register clk rst en 0 (satSucc SatBound <$> counter) diff --git a/clash-prelude/src/Clash/Explicit/Signal.hs b/clash-prelude/src/Clash/Explicit/Signal.hs index 1e3d28bbb0..b1fc5adf67 100644 --- a/clash-prelude/src/Clash/Explicit/Signal.hs +++ b/clash-prelude/src/Clash/Explicit/Signal.hs @@ -208,8 +208,8 @@ module Clash.Explicit.Signal , unsafeFromReset , unsafeToHighPolarity , unsafeToLowPolarity - , unsafeFromHighPolarity - , unsafeFromLowPolarity + , unsafeFromActiveHigh + , unsafeFromActiveLow -- * Basic circuit functions , andEnable , enable -- DEPRECATED @@ -267,6 +267,10 @@ module Clash.Explicit.Signal , readFromBiSignal , writeToBiSignal , mergeBiSignalOuts + + -- * Deprecated + , unsafeFromHighPolarity + , unsafeFromLowPolarity ) where @@ -813,7 +817,7 @@ simulateB_lazy f = simulate_lazy (bundle . f . unbundle) -- | Like 'fromList', but resets on reset and has a defined reset value. -- --- >>> let rst = unsafeFromHighPolarity (fromList [True, True, False, False, True, False]) +-- >>> let rst = unsafeFromActiveHigh (fromList [True, True, False, False, True, False]) -- >>> let res = fromListWithReset @System rst Nothing [Just 'a', Just 'b', Just 'c'] -- >>> sampleN 6 res -- [Nothing,Nothing,Just 'a',Just 'b',Nothing,Just 'a'] diff --git a/clash-prelude/src/Clash/Intel/ClockGen.hs b/clash-prelude/src/Clash/Intel/ClockGen.hs index 8d67edc831..08f6d7d63a 100644 --- a/clash-prelude/src/Clash/Intel/ClockGen.hs +++ b/clash-prelude/src/Clash/Intel/ClockGen.hs @@ -77,13 +77,13 @@ import Clash.Signal.Internal -- where -- (clk, pllStable) = -- 'altpll' \@'Clash.Signal.System' ('SSymbol' \@\"altpll50to100\") clkInp --- ('Clash.Signal.unsafeFromLowPolarity' rstInp) --- rst = 'Clash.Signal.resetSynchronizer' clk ('Clash.Signal.unsafeFromLowPolarity' pllStable) +-- ('Clash.Signal.unsafeFromActiveLow' rstInp) +-- rst = 'Clash.Signal.resetSynchronizer' clk ('Clash.Signal.unsafeFromActiveLow' pllStable) -- @ -- -- 'Clash.Signal.resetSynchronizer' will keep the reset asserted when -- @pllStable@ is 'False', hence the use of --- @'Clash.Signal.unsafeFromLowPolarity' pllStable@. Your circuit will have +-- @'Clash.Signal.unsafeFromActiveLow' pllStable@. Your circuit will have -- signals of type @'Signal' 'Clash.Signal.System'@ and all the clocks and -- resets of your components will be the @clk@ and @rst@ signals generated here -- (modulo local resets, which will be based on @rst@ or never asserted at all @@ -179,13 +179,13 @@ altpll !_ = knownDomain @domIn `seq` knownDomain @domOut `seq` clocks -- where -- (clk :: 'Clock' 'Clash.Signal.System', pllStable :: 'Signal' 'Clash.Signal.System' 'Bool') -- 'alteraPll' ('SSymbol' \@\"alterapll50to100\") clkInp --- ('Clash.Signal.unsafeFromLowPolarity' rstInp) --- rst = 'Clash.Signal.resetSynchronizer' clk ('Clash.Signal.unsafeFromLowPolarity' pllStable) +-- ('Clash.Signal.unsafeFromActiveLow' rstInp) +-- rst = 'Clash.Signal.resetSynchronizer' clk ('Clash.Signal.unsafeFromActiveLow' pllStable) -- @ -- -- 'Clash.Signal.resetSynchronizer' will keep the reset asserted when -- @pllStable@ is 'False', hence the use of --- @'Clash.Signal.unsafeFromLowPolarity' pllStable@. Your circuit will have +-- @'Clash.Signal.unsafeFromActiveLow' pllStable@. Your circuit will have -- signals of type @'Signal' 'Clash.Signal.System'@ and all the clocks and -- resets of your components will be the @clk@ and @rst@ signals generated here -- (modulo local resets, which will be based on @rst@ or never asserted at all diff --git a/clash-prelude/src/Clash/Signal.hs b/clash-prelude/src/Clash/Signal.hs index fefbcabf51..8a7e2ca064 100644 --- a/clash-prelude/src/Clash/Signal.hs +++ b/clash-prelude/src/Clash/Signal.hs @@ -138,8 +138,8 @@ module Clash.Signal , unsafeFromReset , unsafeToHighPolarity , unsafeToLowPolarity - , unsafeFromHighPolarity - , unsafeFromLowPolarity + , unsafeFromActiveHigh + , unsafeFromActiveLow #ifdef CLASH_MULTIPLE_HIDDEN , convertReset #endif @@ -262,6 +262,10 @@ module Clash.Signal , HiddenClockName , HiddenResetName , HiddenEnableName + + -- * Deprecated + , unsafeFromHighPolarity + , unsafeFromLowPolarity ) where @@ -2252,7 +2256,7 @@ holdReset m = -- | Like 'fromList', but resets on reset and has a defined reset value. -- --- >>> let rst = unsafeFromHighPolarity (fromList [True, True, False, False, True, False]) +-- >>> let rst = unsafeFromActiveHigh (fromList [True, True, False, False, True, False]) -- >>> let res = withReset rst (fromListWithReset Nothing [Just 'a', Just 'b', Just 'c']) -- >>> sampleN @System 6 res -- [Nothing,Nothing,Just 'a',Just 'b',Nothing,Just 'a'] diff --git a/clash-prelude/src/Clash/Signal/Internal.hs b/clash-prelude/src/Clash/Signal/Internal.hs index e246eb02c5..a7563665ce 100644 --- a/clash-prelude/src/Clash/Signal/Internal.hs +++ b/clash-prelude/src/Clash/Signal/Internal.hs @@ -97,8 +97,8 @@ module Clash.Signal.Internal , unsafeFromReset , unsafeToHighPolarity , unsafeToLowPolarity - , unsafeFromHighPolarity - , unsafeFromLowPolarity + , unsafeFromActiveHigh + , unsafeFromActiveLow , invertReset -- * Basic circuits , delay# @@ -153,6 +153,10 @@ module Clash.Signal.Internal , traverse# -- * EXTREMELY EXPERIMENTAL , joinSignal# + + -- * Deprecated + , unsafeFromHighPolarity + , unsafeFromLowPolarity ) where @@ -1097,7 +1101,7 @@ resetGenN -> Reset dom resetGenN n = let asserted = replicate (snatToNum n) True in - unsafeFromHighPolarity (fromList (asserted ++ repeat False)) + unsafeFromActiveHigh (fromList (asserted ++ repeat False)) {-# ANN resetGenN hasBlackBox #-} -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE resetGenN #-} @@ -1183,8 +1187,8 @@ unsafeFromReset (Reset r) = r -- it can lead to -- issues in the presence of asynchronous resets. -- --- __NB__: You probably want to use 'unsafeFromLowPolarity' or --- 'unsafeFromHighPolarity'. +-- __NB__: You probably want to use 'unsafeFromActiveLow' or +-- 'unsafeFromActiveHigh'. unsafeToReset :: Signal dom Bool -> Reset dom @@ -1206,7 +1210,23 @@ unsafeFromHighPolarity => Signal dom Bool -- ^ Reset signal that's 'True' when active, and 'False' when inactive. -> Reset dom -unsafeFromHighPolarity r = +unsafeFromHighPolarity = unsafeFromActiveHigh +{-# DEPRECATED unsafeFromHighPolarity "Use 'unsafeFromActiveHigh' instead" #-} + +-- | Interpret a signal of bools as an active high reset and convert it to +-- a reset signal corresponding to the domain's setting. +-- +-- For asynchronous resets it is unsafe because it can cause combinatorial +-- loops. In case of synchronous resets it can lead to +-- in the presence of +-- asynchronous resets. +unsafeFromActiveHigh + :: forall dom + . KnownDomain dom + => Signal dom Bool + -- ^ Reset signal that's 'True' when active, and 'False' when inactive. + -> Reset dom +unsafeFromActiveHigh r = unsafeToReset $ case resetPolarityProxy (Proxy @dom) of SActiveHigh -> r @@ -1225,7 +1245,23 @@ unsafeFromLowPolarity => Signal dom Bool -- ^ Reset signal that's 'False' when active, and 'True' when inactive. -> Reset dom -unsafeFromLowPolarity r = +unsafeFromLowPolarity = unsafeFromActiveLow +{-# DEPRECATED unsafeFromLowPolarity "Use 'unsafeFromActiveLow' instead" #-} + +-- | Interpret a signal of bools as an active low reset and convert it to +-- a reset signal corresponding to the domain's setting. +-- +-- For asynchronous resets it is unsafe because it can cause combinatorial +-- loops. In case of synchronous resets it can lead to +-- in the presence of +-- asynchronous resets. +unsafeFromActiveLow + :: forall dom + . KnownDomain dom + => Signal dom Bool + -- ^ Reset signal that's 'False' when active, and 'True' when inactive. + -> Reset dom +unsafeFromActiveLow r = unsafeToReset $ case resetPolarityProxy (Proxy @dom) of SActiveHigh -> not <$> r diff --git a/clash-prelude/src/Clash/Tutorial.hs b/clash-prelude/src/Clash/Tutorial.hs index 74ba87fca2..54c67d388f 100644 --- a/clash-prelude/src/Clash/Tutorial.hs +++ b/clash-prelude/src/Clash/Tutorial.hs @@ -924,8 +924,8 @@ topEntity topEntity clk rst = 'exposeClockResetEnable' ('mealy' blinkerT (1,False,0) . Clash.Prelude.isRising 1) pllOut rstSync 'enableGen' where - (pllOut,pllStable) = 'Clash.Intel.ClockGen.altpll' \@Dom100 (SSymbol \@\"altpll100\") clk ('Clash.Signal.unsafeFromLowPolarity' rst) - rstSync = 'Clash.Signal.resetSynchronizer' pllOut ('Clash.Signal.unsafeFromLowPolarity' pllStable) + (pllOut,pllStable) = 'Clash.Intel.ClockGen.altpll' \@Dom100 (SSymbol \@\"altpll100\") clk ('Clash.Signal.unsafeFromActiveLow' rst) + rstSync = 'Clash.Signal.resetSynchronizer' pllOut ('Clash.Signal.unsafeFromActiveLow' pllStable) blinkerT (leds,mode,cntr) key1R = ((leds',mode',cntr'),leds) where @@ -2505,8 +2505,8 @@ topEntity topEntity clk rst = 'exposeClockResetEnable' ('mealy' blinkerT (1,False,0) . Clash.Prelude.isRising 1) pllOut rstSync 'enableGen' where - (pllOut,pllStable) = 'Clash.Intel.ClockGen.altpll' \@Dom100 (SSymbol \@\"altpll100\") clk ('Clash.Signal.unsafeFromLowPolarity' rst) - rstSync = 'Clash.Signal.resetSynchronizer' pllOut ('Clash.Signal.unsafeFromLowPolarity' pllStable) + (pllOut,pllStable) = 'Clash.Intel.ClockGen.altpll' \@Dom100 (SSymbol \@\"altpll100\") clk ('Clash.Signal.unsafeFromActiveLow' rst) + rstSync = 'Clash.Signal.resetSynchronizer' pllOut ('Clash.Signal.unsafeFromActiveLow' pllStable) blinkerT (leds,mode,cntr) key1R = ((leds',mode',cntr'),leds) where diff --git a/clash-prelude/tests/Clash/Tests/AsyncFIFOSynchronizer.hs b/clash-prelude/tests/Clash/Tests/AsyncFIFOSynchronizer.hs index 5d5d74d0ca..19220d3877 100644 --- a/clash-prelude/tests/Clash/Tests/AsyncFIFOSynchronizer.hs +++ b/clash-prelude/tests/Clash/Tests/AsyncFIFOSynchronizer.hs @@ -1053,8 +1053,8 @@ fifoOperations racts wacts = (bundle (rAllDone, rel), bundle (wAllDone, wel)) wclk = clockGen @wdom -- Not resetting makes the test easier to interpret and actual proper testing -- of reset behaviour is a lot more involved. - noRRst = unsafeFromHighPolarity @rdom (pure False) - noWRst = unsafeFromHighPolarity @wdom (pure False) + noRRst = unsafeFromActiveHigh @rdom (pure False) + noWRst = unsafeFromActiveHigh @wdom (pure False) (wdone, wact) = unbundle $ fromList $ P.zip (P.repeat False) wacts <> P.repeat (True, WNoOp) (rdone, ract) = diff --git a/clash-prelude/tests/Clash/Tests/Reset.hs b/clash-prelude/tests/Clash/Tests/Reset.hs index c526e85a92..b93abe201c 100644 --- a/clash-prelude/tests/Clash/Tests/Reset.hs +++ b/clash-prelude/tests/Clash/Tests/Reset.hs @@ -23,7 +23,7 @@ sampleResetN :: KnownDomain dom => Int -> Reset dom -> [Bool] sampleResetN n = sampleN n . unsafeToHighPolarity resetFromList :: KnownDomain dom => [Bool] -> Reset dom -resetFromList = unsafeFromHighPolarity . fromList +resetFromList = unsafeFromActiveHigh . fromList onePeriodGlitchReset :: KnownDomain dom => Reset dom onePeriodGlitchReset = diff --git a/clash-prelude/tests/Clash/Tests/Signal.hs b/clash-prelude/tests/Clash/Tests/Signal.hs index b2b6a7c420..2c4f119cbd 100644 --- a/clash-prelude/tests/Clash/Tests/Signal.hs +++ b/clash-prelude/tests/Clash/Tests/Signal.hs @@ -113,7 +113,7 @@ tests = "Implicit" [ -- See: https://github.com/clash-lang/clash-compiler/pull/655 let rst0 = fromList [True, True, False, False, True, True] - rst1 = unsafeFromHighPolarity rst0 + rst1 = unsafeFromActiveHigh rst0 reg = register 'a' (pure 'b') #ifdef CLASH_MULTIPLE_HIDDEN sig = withReset rst1 reg diff --git a/examples/Blinker.hs b/examples/Blinker.hs index 3e2c58bea8..a93e1bb7ef 100644 --- a/examples/Blinker.hs +++ b/examples/Blinker.hs @@ -65,8 +65,8 @@ topEntity clk20 rstBtn modeBtn = -- Signal coming from the reset button is low when pressed, and high when -- not pressed. We convert this signal to the polarity of our domain with - -- 'unsafeFromLowPolarity'. - rst = unsafeFromLowPolarity rstBtn + -- 'unsafeFromActiveLow'. + rst = unsafeFromActiveLow rstBtn -- Instantiate a PLL: this stabilizes the incoming clock signal and indicates -- when the signal is stable. We're also using it to transform an incoming @@ -80,11 +80,11 @@ topEntity clk20 rstBtn modeBtn = -- Synchronize reset to clock signal coming from PLL. We want the reset to -- remain active while the PLL is NOT stable, hence the conversion with - -- 'unsafeFromLowPolarity' + -- 'unsafeFromActiveLow' rstSync = resetSynchronizer clk50 - (unsafeFromLowPolarity pllStable) + (unsafeFromActiveLow pllStable) flipMode :: LedMode -> LedMode flipMode Rotate = Complement diff --git a/tests/shouldwork/Cores/Xilinx/DcFifo/Basic.hs b/tests/shouldwork/Cores/Xilinx/DcFifo/Basic.hs index b500dece35..2914b47791 100644 --- a/tests/shouldwork/Cores/Xilinx/DcFifo/Basic.hs +++ b/tests/shouldwork/Cores/Xilinx/DcFifo/Basic.hs @@ -81,7 +81,7 @@ testBench = done (pack <$> fifoData maxOut) (fExpectedData <$> fsmOut) (fDone <$> fsmOut) clk = tbClockGen (not <$> done) - noRst = unsafeFromHighPolarity $ pure False + noRst = unsafeFromActiveHigh $ pure False en = enableGen -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE testBench #-} diff --git a/tests/shouldwork/Cores/Xilinx/DcFifo/Lfsr.hs b/tests/shouldwork/Cores/Xilinx/DcFifo/Lfsr.hs index cdd3e2267a..12ea82f647 100644 --- a/tests/shouldwork/Cores/Xilinx/DcFifo/Lfsr.hs +++ b/tests/shouldwork/Cores/Xilinx/DcFifo/Lfsr.hs @@ -120,8 +120,8 @@ mkTestBench cFifo = done where (rClk, wClk) = biTbClockGen (not <$> done) - noRRst = unsafeFromHighPolarity $ pure False - noWRst = unsafeFromHighPolarity $ pure False + noRRst = unsafeFromActiveHigh $ pure False + noWRst = unsafeFromActiveHigh $ pure False rEna = enableGen wEna = enableGen diff --git a/tests/shouldwork/Cores/Xilinx/TdpBlockRam.hs b/tests/shouldwork/Cores/Xilinx/TdpBlockRam.hs index 055998f8d5..f38a668cdf 100644 --- a/tests/shouldwork/Cores/Xilinx/TdpBlockRam.hs +++ b/tests/shouldwork/Cores/Xilinx/TdpBlockRam.hs @@ -31,10 +31,10 @@ topEntity {-# CLASH_OPAQUE topEntity #-} noRstA :: Reset A -noRstA = unsafeFromHighPolarity (pure False) +noRstA = unsafeFromActiveHigh (pure False) noRstB :: Reset B -noRstB = unsafeFromHighPolarity (pure False) +noRstB = unsafeFromActiveHigh (pure False) tb :: ( KnownNat n0, KnownNat n1, KnownNat n2, KnownNat n3 diff --git a/tests/shouldwork/Cores/Xilinx/XpmCdcArraySingleTypes.hs b/tests/shouldwork/Cores/Xilinx/XpmCdcArraySingleTypes.hs index 9eea5893f7..2ab8f32f74 100644 --- a/tests/shouldwork/Cores/Xilinx/XpmCdcArraySingleTypes.hs +++ b/tests/shouldwork/Cores/Xilinx/XpmCdcArraySingleTypes.hs @@ -14,7 +14,7 @@ createDomain vXilinxSystem{vName="D10", vPeriod=hzToPeriod 100e6} createDomain vXilinxSystem{vName="D11", vPeriod=hzToPeriod 110e6} noRst :: KnownDomain dom => Reset dom -noRst = unsafeFromHighPolarity (pure False) +noRst = unsafeFromActiveHigh (pure False) tb :: forall a b stages width n . diff --git a/tests/shouldwork/Cores/Xilinx/XpmCdcGrayTypes.hs b/tests/shouldwork/Cores/Xilinx/XpmCdcGrayTypes.hs index fb2a949283..a5827bf82d 100644 --- a/tests/shouldwork/Cores/Xilinx/XpmCdcGrayTypes.hs +++ b/tests/shouldwork/Cores/Xilinx/XpmCdcGrayTypes.hs @@ -14,7 +14,7 @@ createDomain vXilinxSystem{vName="D10", vPeriod=hzToPeriod 100e6} createDomain vXilinxSystem{vName="D11", vPeriod=hzToPeriod 110e6} noRst :: KnownDomain dom => Reset dom -noRst = unsafeFromHighPolarity (pure False) +noRst = unsafeFromActiveHigh (pure False) tb :: forall a b width stages n . diff --git a/tests/shouldwork/Cores/Xilinx/XpmCdcHandshakeTypes.hs b/tests/shouldwork/Cores/Xilinx/XpmCdcHandshakeTypes.hs index c0eb101e27..c6f75eea69 100644 --- a/tests/shouldwork/Cores/Xilinx/XpmCdcHandshakeTypes.hs +++ b/tests/shouldwork/Cores/Xilinx/XpmCdcHandshakeTypes.hs @@ -18,7 +18,7 @@ createDomain vXilinxSystem{vName="D11", vPeriod=hzToPeriod 110e6} data State = WaitForDeassert | WaitForAssert deriving (Generic, NFDataX) noRst :: KnownDomain dom => Reset dom -noRst = unsafeFromHighPolarity (pure False) +noRst = unsafeFromActiveHigh (pure False) -- | Transfer 1, 2, 3, ... to destination domain srcFsm :: diff --git a/tests/shouldwork/Cores/Xilinx/XpmCdcSingleTypes.hs b/tests/shouldwork/Cores/Xilinx/XpmCdcSingleTypes.hs index c3068b1515..c84471386c 100644 --- a/tests/shouldwork/Cores/Xilinx/XpmCdcSingleTypes.hs +++ b/tests/shouldwork/Cores/Xilinx/XpmCdcSingleTypes.hs @@ -16,7 +16,7 @@ createDomain vXilinxSystem{vName="D10", vPeriod=hzToPeriod 100e6} createDomain vXilinxSystem{vName="D11", vPeriod=hzToPeriod 110e6} noRst :: KnownDomain dom => Reset dom -noRst = unsafeFromHighPolarity (pure False) +noRst = unsafeFromActiveHigh (pure False) tb :: forall a b stages n . diff --git a/tests/shouldwork/Issues/T1742.hs b/tests/shouldwork/Issues/T1742.hs index d69358e7aa..45fcf0438c 100644 --- a/tests/shouldwork/Issues/T1742.hs +++ b/tests/shouldwork/Issues/T1742.hs @@ -21,7 +21,7 @@ topEntity -> "LED" ::: Signal Bank2C (BitVector 4) topEntity clk rstnButton = exposeClockResetEnable top clk rst en where en = enableGen - rst = unsafeFromLowPolarity rstnButton + rst = unsafeFromActiveLow rstnButton rstSync = resetSynchronizer clk rst makeTopEntityWithName 'topEntity "shell" diff --git a/tests/shouldwork/Netlist/T1766.hs b/tests/shouldwork/Netlist/T1766.hs index 2eee6e8e8a..812101f3f3 100644 --- a/tests/shouldwork/Netlist/T1766.hs +++ b/tests/shouldwork/Netlist/T1766.hs @@ -44,7 +44,7 @@ knightrider clk rst ena = pack <$> leds topEntity :: Clock System -> Signal System Bool -> Signal System (BitVector 8) topEntity clk rstBool = knightrider clk rst enableGen where - rst = unsafeFromLowPolarity rstBool + rst = unsafeFromActiveLow rstBool testPath :: FilePath testPath = "tests/shouldwork/Netlist/T1766.hs" diff --git a/tests/shouldwork/Signal/BlockRam0.hs b/tests/shouldwork/Signal/BlockRam0.hs index 83e3037b64..7c01fd0cdf 100644 --- a/tests/shouldwork/Signal/BlockRam0.hs +++ b/tests/shouldwork/Signal/BlockRam0.hs @@ -99,6 +99,6 @@ testBench = done :> Nil) - done = expectedOutput (topEntity clk (unsafeFromHighPolarity rst0) enableGen rd wr) + done = expectedOutput (topEntity clk (unsafeFromActiveHigh rst0) enableGen rd wr) clk = tbSystemClockGen (not <$> done) rst = systemResetGen diff --git a/tests/shouldwork/Signal/BlockRam1.hs b/tests/shouldwork/Signal/BlockRam1.hs index 03ac1db6d3..3ff38a51e9 100644 --- a/tests/shouldwork/Signal/BlockRam1.hs +++ b/tests/shouldwork/Signal/BlockRam1.hs @@ -111,6 +111,6 @@ testBench = done :> Nil) - done = expectedOutput (topEntity clk (unsafeFromHighPolarity rst0) enableGen rd wr) + done = expectedOutput (topEntity clk (unsafeFromActiveHigh rst0) enableGen rd wr) clk = tbSystemClockGen (not <$> done) rst = systemResetGen diff --git a/tests/shouldwork/Signal/DelayedReset.hs b/tests/shouldwork/Signal/DelayedReset.hs index 577db0a622..dcbcc04e14 100644 --- a/tests/shouldwork/Signal/DelayedReset.hs +++ b/tests/shouldwork/Signal/DelayedReset.hs @@ -15,7 +15,7 @@ topEntity clk reset en = (cycleCount, countFromReset, newResetSig) where newReset ::Reset System newReset - = unsafeFromHighPolarity newResetSig + = unsafeFromActiveHigh newResetSig newResetSig = register clk reset en True diff --git a/tests/shouldwork/Signal/DualBlockRamDefinitions.hs b/tests/shouldwork/Signal/DualBlockRamDefinitions.hs index 6727c6f62c..8bdae5bc02 100644 --- a/tests/shouldwork/Signal/DualBlockRamDefinitions.hs +++ b/tests/shouldwork/Signal/DualBlockRamDefinitions.hs @@ -117,11 +117,11 @@ clk10TH = clockGen @B clk7TH = clockGen @C noRst20 :: Reset A -noRst20 = unsafeFromHighPolarity (pure False) +noRst20 = unsafeFromActiveHigh (pure False) noRst10 :: Reset B -noRst10 = unsafeFromHighPolarity (pure False) +noRst10 = unsafeFromActiveHigh (pure False) noRst7 :: Reset C -noRst7 = unsafeFromHighPolarity (pure False) +noRst7 = unsafeFromActiveHigh (pure False) twice = concatMap (replicate d2) strictAnd !a !b = (&&) a b diff --git a/tests/shouldwork/Signal/Ram/RMulti.hs b/tests/shouldwork/Signal/Ram/RMulti.hs index 75e9c79417..864994a49a 100644 --- a/tests/shouldwork/Signal/Ram/RMulti.hs +++ b/tests/shouldwork/Signal/Ram/RMulti.hs @@ -35,8 +35,8 @@ tbOutput top wClk rClk = output Just (0, 1) :> Just (1,2) :> Nothing :> Nil rd = delay rClk enableGen 0 $ rd + 1 output = ignoreFor rClk rNoReset enableGen d2 0 $ top wClk rClk rd wrM - wNoReset = unsafeFromHighPolarity @P20 (pure False) - rNoReset = unsafeFromHighPolarity @P10 (pure False) + wNoReset = unsafeFromActiveHigh @P20 (pure False) + rNoReset = unsafeFromActiveHigh @P10 (pure False) {-# INLINE tbOutput #-} tb @@ -51,5 +51,5 @@ tb top expectedSamples = done expectedOutput = outputVerifier' rClk noReset expectedSamples done = expectedOutput output (rClk, wClk) = biTbClockGen (not <$> done) :: (Clock P10, Clock P20) - noReset = unsafeFromHighPolarity @P10 (pure False) + noReset = unsafeFromActiveHigh @P10 (pure False) {-# INLINE tb #-} diff --git a/tests/shouldwork/Signal/Ram/RWMulti.hs b/tests/shouldwork/Signal/Ram/RWMulti.hs index 4284059327..db62f8f0af 100644 --- a/tests/shouldwork/Signal/Ram/RWMulti.hs +++ b/tests/shouldwork/Signal/Ram/RWMulti.hs @@ -55,7 +55,7 @@ tbOutput top wClk rClk = output where wrD = delay wClk enableGen 0 $ wrD + 1 output = ignoreFor rClk noReset enableGen d1 0 $ top wClk rClk wrD - noReset = unsafeFromHighPolarity @rdom (pure False) + noReset = unsafeFromActiveHigh @rdom (pure False) {-# INLINE tbOutput #-} tb @@ -76,5 +76,5 @@ tb top expectedSamples = done expectedOutput = outputVerifier' rClk noReset expectedSamples done = expectedOutput output (rClk, wClk) = biTbClockGen (not <$> done) :: (Clock rdom, Clock wdom) - noReset = unsafeFromHighPolarity @rdom (pure False) + noReset = unsafeFromActiveHigh @rdom (pure False) {-# INLINE tb #-} diff --git a/tests/shouldwork/Signal/RegisterAE.hs b/tests/shouldwork/Signal/RegisterAE.hs index ca3b052b8f..6d91e1367e 100644 --- a/tests/shouldwork/Signal/RegisterAE.hs +++ b/tests/shouldwork/Signal/RegisterAE.hs @@ -52,7 +52,7 @@ topEntity clk rst en = head <$> r topEntityAE clk rst = topEntity clk arst en where - arst = unsafeFromHighPolarity (resetInput clk rst enableGen) + arst = unsafeFromActiveHigh (resetInput clk rst enableGen) en = toEnable (enableInput clk rst enableGen) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE topEntityAE #-} diff --git a/tests/shouldwork/Signal/RegisterAR.hs b/tests/shouldwork/Signal/RegisterAR.hs index 0cbfd791d7..ecce82ba81 100644 --- a/tests/shouldwork/Signal/RegisterAR.hs +++ b/tests/shouldwork/Signal/RegisterAR.hs @@ -35,7 +35,7 @@ topEntity clk rst = head <$> r topEntityAR clk rst = topEntity clk arst where - arst = unsafeFromHighPolarity (resetInput clk rst enableGen) + arst = unsafeFromActiveHigh (resetInput clk rst enableGen) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE topEntityAR #-} diff --git a/tests/shouldwork/Signal/RegisterSE.hs b/tests/shouldwork/Signal/RegisterSE.hs index 903e10fd7a..8d480411a2 100644 --- a/tests/shouldwork/Signal/RegisterSE.hs +++ b/tests/shouldwork/Signal/RegisterSE.hs @@ -51,7 +51,7 @@ topEntity clk rst en = head <$> r topEntitySE clk rst = topEntity clk arst en where - arst = unsafeFromHighPolarity (resetInput clk rst enableGen) + arst = unsafeFromActiveHigh (resetInput clk rst enableGen) en = toEnable (enableInput clk rst enableGen) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE topEntitySE #-} diff --git a/tests/shouldwork/Signal/RegisterSR.hs b/tests/shouldwork/Signal/RegisterSR.hs index f534bee29e..efe32e8847 100644 --- a/tests/shouldwork/Signal/RegisterSR.hs +++ b/tests/shouldwork/Signal/RegisterSR.hs @@ -34,7 +34,7 @@ topEntity clk rst = head <$> r topEntitySR clk rst = topEntity clk srst where - srst = unsafeFromHighPolarity (resetInput clk rst enableGen) + srst = unsafeFromActiveHigh (resetInput clk rst enableGen) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE topEntitySR #-} diff --git a/tests/shouldwork/Signal/ResetSynchronizer.hs b/tests/shouldwork/Signal/ResetSynchronizer.hs index d6369b6117..ea5431b216 100644 --- a/tests/shouldwork/Signal/ResetSynchronizer.hs +++ b/tests/shouldwork/Signal/ResetSynchronizer.hs @@ -21,7 +21,7 @@ testReset :: Clock circuitDom -> Reset circuitDom testReset tbClk tbRst cClk = - unsafeFromHighPolarity + unsafeFromActiveHigh $ unsafeSynchronizer tbClk cClk $ stimuliGenerator tbClk tbRst ( True diff --git a/tests/shouldwork/Xilinx/ClockWizard.hs b/tests/shouldwork/Xilinx/ClockWizard.hs index 72e057cdf2..2af28d362d 100644 --- a/tests/shouldwork/Xilinx/ClockWizard.hs +++ b/tests/shouldwork/Xilinx/ClockWizard.hs @@ -25,10 +25,10 @@ topEntity :: topEntity clkInSE clkInDiff rstIn = let f clk rst = register clk rst enableGen 0 . fmap (satSucc SatBound) (clkA, stableA) = clockWizard (SSymbol @"clk_wiz_se") clkInSE rstIn - rstA = unsafeFromLowPolarity stableA + rstA = unsafeFromActiveLow stableA (clkB, stableB) = clockWizardDifferential (SSymbol @"clk_wiz_diff") clkInDiff rstIn - rstB = unsafeFromLowPolarity stableB + rstB = unsafeFromActiveLow stableB o1 = f clkA rstA o1 o2 = f clkB rstB o2 in bundle (o1, o2)