diff --git a/changelog/2025-03-19T08_52_01+01_00_new_partial_signal_operators b/changelog/2025-03-19T08_52_01+01_00_new_partial_signal_operators new file mode 100644 index 0000000000..b6c92bec12 --- /dev/null +++ b/changelog/2025-03-19T08_52_01+01_00_new_partial_signal_operators @@ -0,0 +1 @@ +ADDED: Alongside the existing Eq-like and Ord-like signal operators like `.==.` and `.<=.` etc. There are now new functions for comparing with constants: `.==`, `==.`, `./=`, `/=.`, `.<=`, `<=.`, `.>=`, `>=.`, `.>`, `>.`, `.<`, `<.`, `.&&`, `&&.`, `.||`, `||.`. These are useful for comparing signals with constants in a more readable way. For example, `a .==. pure True` can now be replaced with `a .== True`. diff --git a/clash-prelude/src/Clash/Explicit/Signal.hs b/clash-prelude/src/Clash/Explicit/Signal.hs index 26ec664ae3..3f707fc4ef 100644 --- a/clash-prelude/src/Clash/Explicit/Signal.hs +++ b/clash-prelude/src/Clash/Explicit/Signal.hs @@ -276,9 +276,9 @@ module Clash.Explicit.Signal , testFor -- * Type classes -- ** 'Eq'-like - , (.==.), (./=.) + , (.==.), (.==), (==.), (./=.), (./=), (/=.) -- ** 'Ord'-like - , (.<.), (.<=.), (.>=.), (.>.) + , (.<.), (.<), (<.), (.<=.), (.<=), (<=.), (.>=.), (.>=), (>=.), (.>.), (.>), (>.) -- * Bisignal functions , veryUnsafeToBiSignalIn , readFromBiSignal diff --git a/clash-prelude/src/Clash/Signal.hs b/clash-prelude/src/Clash/Signal.hs index 7f303385c6..1a57567c56 100644 --- a/clash-prelude/src/Clash/Signal.hs +++ b/clash-prelude/src/Clash/Signal.hs @@ -241,9 +241,9 @@ module Clash.Signal , testFor -- * Type classes -- ** 'Eq'-like - , (.==.), (./=.) + , (.==.), (.==), (==.), (./=.), (./=), (/=.) -- ** 'Ord'-like - , (.<.), (.<=.), (.>=.), (.>.) + , (.<.), (.<), (<.), (.<=.), (.<=), (<=.), (.>=.), (.>=), (>=.), (.>.), (.>), (>.) -- * Bisignal functions , veryUnsafeToBiSignalIn , readFromBiSignal diff --git a/clash-prelude/src/Clash/Signal/Internal.hs b/clash-prelude/src/Clash/Signal/Internal.hs index 3a9ca3bd27..888120ed03 100644 --- a/clash-prelude/src/Clash/Signal/Internal.hs +++ b/clash-prelude/src/Clash/Signal/Internal.hs @@ -138,7 +138,7 @@ module Clash.Signal.Internal , resetGen , resetGenN -- * Boolean connectives - , (.&&.), (.||.) + , (.&&.), (&&.), (.&&), (.||.), (||.), (.||) -- * Simulation functions (not synthesizable) , simulate -- ** lazy version @@ -157,9 +157,9 @@ module Clash.Signal.Internal , testFor -- * Type classes -- ** 'Eq'-like - , (.==.), (./=.) + , (.==.), (.==), (==.), (./=.), (./=), (/=.) -- ** 'Ord'-like - , (.<.), (.<=.), (.>=.), (.>.) + , (.<.), (.<), (<.), (.<=.), (.<=), (<=.), (.>=.), (.>=), (>=.), (.>.), (.>), (>.) -- ** 'Functor' , mapSignal# -- ** 'Applicative' @@ -1421,6 +1421,30 @@ infixr 2 .||. (.||.) :: Applicative f => f Bool -> f Bool -> f Bool (.||.) = liftA2 (||) +infix 2 .|| +-- | The above type is a generalization for: +-- +-- @ +-- __(.||)__ :: 'Ord' a => 'Clash.Signal.Signal' Bool -> 'Bool' -> 'Clash.Signal.Signal' 'Bool' +-- @ +-- +-- It is a version of ('||') that allows comparing a @'Clash.Signal.Signal' Bool@ with a constant +-- @Bool@ and returns a 'Clash.Signal.Signal' of 'Bool' +(.||) :: Functor f => f Bool -> Bool -> f Bool +a .|| b = fmap (|| b) a + +infixr 2 ||. +-- | The above type is a generalization for: +-- +-- @ +-- __(||.)__ :: 'Clash.Signal.Signal' 'Bool' -> 'Clash.Signal.Signal' 'Bool' -> 'Clash.Signal.Signal' 'Bool' +-- @ +-- +-- It is a version of ('||') that allows comparing a constant @Bool@ with a @'Clash.Signal.Signal' Bool@ +-- and returns a 'Clash.Signal.Signal' of 'Bool' +(||.) :: Functor f => Bool -> f Bool -> f Bool +a ||. b = fmap (a ||) b + infixr 3 .&&. -- | The above type is a generalization for: -- @@ -1432,6 +1456,30 @@ infixr 3 .&&. (.&&.) :: Applicative f => f Bool -> f Bool -> f Bool (.&&.) = liftA2 (&&) +infixr 3 .&& +-- | The above type is a generalization for: +-- +-- @ +-- __(.&&)__ :: 'Clash.Signal.Signal' 'Bool' -> 'Clash.Signal.Signal' 'Bool' -> 'Clash.Signal.Signal' 'Bool' +-- @ +-- +-- It is a version of ('&&') that allows comparing a @'Clash.Signal.Signal' Bool@ with a +-- constant @Bool@ and returns a 'Clash.Signal.Signal' of 'Bool' +(.&&) :: (Functor f) => f Bool -> Bool -> f Bool +(.&&) a b = fmap (&& b) a + +infixr 3 &&. +-- | The above type is a generalization for: +-- +-- @ +-- __(&&.)__ :: 'Clash.Signal.Signal' 'Bool' -> 'Clash.Signal.Signal' 'Bool' -> 'Clash.Signal.Signal' 'Bool' +-- @ +-- +-- It is a version of ('&&') that allows comparing a constant @'Bool@ with a +-- @'Clash.Signal.Signal' Bool@ and returns a 'Clash.Signal.Signal' of 'Bool' +(&&.) :: (Functor f) => Bool -> f Bool -> f Bool +(&&.) a b = fmap (a &&) b + -- [Note: register strictness annotations] -- -- In order to produce the first (current) value of the register's output @@ -1611,6 +1659,30 @@ infix 4 .==. (.==.) :: (Eq a, Applicative f) => f a -> f a -> f Bool (.==.) = liftA2 (==) +infix 4 .== +-- | The above type is a generalization for: +-- +-- @ +-- __(.==)__ :: 'Eq' a => 'Clash.Signal.Signal' a -> a -> 'Clash.Signal.Signal' 'Bool' +-- @ +-- +-- It is a version of ('==') that allows comparing a @'Clash.Signal.Signal' a@ with a +-- constant @a@ and returns a 'Clash.Signal.Signal' of 'Bool' +(.==) :: (Eq a, Functor f) => f a -> a -> f Bool +(.==) a b = fmap (==b) a + +infix 4 ==. +-- | The above type is a generalization for: +-- +-- @ +-- __(==.)__ :: 'Eq' a => a -> 'Clash.Signal.Signal' a -> 'Clash.Signal.Signal' 'Bool' +-- @ +-- +-- It is a version of ('==') that allows comparing a @'Clash.Signal.Signal' a@ with a +-- constant @a@ and returns a 'Clash.Signal.Signal' of 'Bool' +(==.) :: (Eq a, Functor f) => a -> f a -> f Bool +(==.) a b = fmap (a==) b + infix 4 ./=. -- | The above type is a generalization for: -- @@ -1622,6 +1694,31 @@ infix 4 ./=. (./=.) :: (Eq a, Applicative f) => f a -> f a -> f Bool (./=.) = liftA2 (/=) +infix 4 ./= +-- | The above type is a generalization for: +-- +-- @ +-- __(./=)__ :: 'Eq' a => 'Clash.Signal.Signal' a -> a -> 'Clash.Signal.Signal' 'Bool' +-- @ +-- +-- It is a version of ('/=') that allows comparing a @'Clash.Signal.Signal' a@ with a +-- constant @a@ and returns a 'Clash.Signal.Signal' of 'Bool' +(./=) :: (Eq a, Functor f) => f a -> a -> f Bool +(./=) a b = fmap (/=b) a + +infix 4 /=. +-- | The above type is a generalization for: +-- +-- @ +-- __(/=.)__ :: 'Eq' a => a -> 'Clash.Signal.Signal' a -> 'Clash.Signal.Signal' 'Bool' +-- @ +-- +-- It is a version of ('/=') that allows comparing a @'Clash.Signal.Signal' a@ with a +-- constant @a@ and returns a 'Clash.Signal.Signal' of 'Bool' + +(/=.) :: (Eq a, Functor f) => a -> f a -> f Bool +(/=.) a b = fmap (a /=) b + infix 4 .<. -- | The above type is a generalization for: -- @@ -1633,6 +1730,30 @@ infix 4 .<. (.<.) :: (Ord a, Applicative f) => f a -> f a -> f Bool (.<.) = liftA2 (<) +infix 4 <. +-- | The above type is a generalization for: +-- +-- @ +-- __(<.)__ :: 'Ord' a => a -> 'Clash.Signal.Signal' a -> 'Clash.Signal.Signal' 'Bool' +-- @ +-- +-- It is a version of ('<') that allows comparing a @'Clash.Signal.Signal' a@ with a constant +-- @a@ and returns a 'Clash.Signal.Signal' of 'Bool' +(<.) :: (Ord a, Functor f) => a -> f a -> f Bool +(<.) a b = fmap (a<) b + +infix 4 .< +-- | The above type is a generalization for: +-- +-- @ +-- __(.<)__ :: 'Ord' a => 'Clash.Signal.Signal' a -> a -> 'Clash.Signal.Signal' 'Bool' +-- @ +-- +-- It is a version of ('<') that allows comparing a @'Clash.Signal.Signal' a@ with a constant +-- @a@ and returns a 'Clash.Signal.Signal' of 'Bool' +(.<) :: (Ord a, Functor f) => f a -> a -> f Bool +(.<) a b = fmap ( f a -> f a -> f Bool (.<=.) = liftA2 (<=) +infix 4 .<= +-- | The above type is a generalization for: +-- +-- @ +-- __(.<=)__ :: 'Ord' a => 'Clash.Signal.Signal' a -> a -> 'Clash.Signal.Signal' 'Bool' +-- @ +-- +-- It is a version of ('GHC.TypeNats.<=') that allows comparing a @'Clash.Signal.Signal' a@ with a constant +-- @a@ and returns a 'Clash.Signal.Signal' of 'Bool' +(.<=) :: (Ord a, Functor f) => f a -> a -> f Bool +(.<=) a b = fmap (<=b) a + +infix 4 <=. +-- | The above type is a generalization for: +-- +-- @ +-- __(<=.)__ :: 'Ord' a => a -> 'Clash.Signal.Signal' a -> 'Clash.Signal.Signal' 'Bool' +-- @ +-- +-- It is a version of ('GHC.TypeNats.<=') that allows comparing a @'Clash.Signal.Signal' a@ with a constant +-- @a@ and returns a 'Clash.Signal.Signal' of 'Bool' +(<=.) :: (Ord a, Functor f) => a -> f a -> f Bool +(<=.) a b = fmap (a<=)b + infix 4 .>. -- | The above type is a generalization for: -- @@ -1655,6 +1800,30 @@ infix 4 .>. (.>.) :: (Ord a, Applicative f) => f a -> f a -> f Bool (.>.) = liftA2 (>) +infix 4 .> +-- | The above type is a generalization for: +-- +-- @ +-- __(.>)__ :: 'Ord' a => 'Clash.Signal.Signal' a -> a -> 'Clash.Signal.Signal' 'Bool' +-- @ +-- +-- It is a version of ('>') that allows comparing a @'Clash.Signal.Signal' a@ with a constant +-- @a@ and returns a 'Clash.Signal.Signal' of 'Bool' +(.>) :: (Ord a, Functor f) => f a -> a -> f Bool +(.>) a b = fmap (>b) a + +infix 4 >. +-- | The above type is a generalization for: +-- +-- @ +-- __(>.)__ :: 'Ord' a => a -> 'Clash.Signal.Signal' a -> 'Clash.Signal.Signal' 'Bool' +-- @ +-- +-- It is a version of ('>') that allows comparing a @'Clash.Signal.Signal' a@ with a constant +-- @a@ and returns a 'Clash.Signal.Signal' of 'Bool' +(>.) :: (Ord a, Functor f) => a -> f a -> f Bool +(>.) a b = fmap (a>) b + infix 4 .>=. -- | The above type is a generalization for: -- @@ -1666,6 +1835,30 @@ infix 4 .>=. (.>=.) :: (Ord a, Applicative f) => f a -> f a -> f Bool (.>=.) = liftA2 (>=) +infix 4 .>= +-- | The above type is a generalization for: +-- +-- @ +-- __(.>=)__ :: 'Ord' a => 'Clash.Signal.Signal' a -> a -> 'Clash.Signal.Signal' 'Bool' +-- @ +-- +-- It is a version of ('>=') that allows comparing a @'Clash.Signal.Signal' a@ with a constant +-- @a@ and returns a 'Clash.Signal.Signal' of 'Bool' +(.>=) :: (Ord a, Functor f) => f a -> a -> f Bool +(.>=) a b = fmap (>=b) a + +infix 4 >=. +-- | The above type is a generalization for: +-- +-- @ +-- __(>=.)__ :: 'Ord' a => a -> 'Clash.Signal.Signal' a -> 'Clash.Signal.Signal' 'Bool' +-- @ +-- +-- It is a version of ('>=') that allows comparing a @'Clash.Signal.Signal' a@ with a constant +-- @a@ and returns a 'Clash.Signal.Signal' of 'Bool' +(>=.) :: (Ord a, Functor f) => a -> f a -> f Bool +(>=.) a b = fmap (a>=) b + instance Fractional a => Fractional (Signal dom a) where (/) = liftA2 (/) recip = fmap recip diff --git a/clash-prelude/tests/Clash/Tests/BlockRam.hs b/clash-prelude/tests/Clash/Tests/BlockRam.hs index e0e77aaf99..b69a8fdd8d 100644 --- a/clash-prelude/tests/Clash/Tests/BlockRam.hs +++ b/clash-prelude/tests/Clash/Tests/BlockRam.hs @@ -14,7 +14,7 @@ readRam :: (HiddenClockResetEnable dom) => Signal dom (Unsigned 4) -> Signal dom (Unsigned 8) -readRam addr = mux (register False $ addr .<. 8) ram (pure 0xff) +readRam addr = mux (register False $ addr .< 8) ram (pure 0xff) where ram = blockRam1 NoClearOnReset (SNat @8) 0 addr (pure Nothing) diff --git a/clash-prelude/tests/Clash/Tests/Ram.hs b/clash-prelude/tests/Clash/Tests/Ram.hs index 3eeaa6db13..d9e9b4a6f1 100644 --- a/clash-prelude/tests/Clash/Tests/Ram.hs +++ b/clash-prelude/tests/Clash/Tests/Ram.hs @@ -51,7 +51,7 @@ ram rd we wr din = maskOobRead :: Ram maskOobRead rd we wr din = - maybeIsX <$> mux (rd .<. 2) ram0 (pure 4) + maybeIsX <$> mux (rd .< 2) ram0 (pure 4) where ram0 = asyncRam# clockGen clockGen enableGen d2 rd we wr din diff --git a/tests/shouldfail/Verification/NonTemporal.hs b/tests/shouldfail/Verification/NonTemporal.hs index 7c60d1e163..1c6596af95 100644 --- a/tests/shouldfail/Verification/NonTemporal.hs +++ b/tests/shouldfail/Verification/NonTemporal.hs @@ -25,7 +25,7 @@ assertCvResult assertCvResult clk rst gen max results = done where counter = register clk rst gen (minBound :: n) (succ <$> counter) - done = hideAssertion results (counter .==. pure maxBound) + done = hideAssertion results (counter .== maxBound) {-# INLINE assertCvResult #-} binaryTest diff --git a/tests/shouldwork/Basic/AES.hs b/tests/shouldwork/Basic/AES.hs index 8a35fdbaf2..6276c202b5 100644 --- a/tests/shouldwork/Basic/AES.hs +++ b/tests/shouldwork/Basic/AES.hs @@ -89,7 +89,7 @@ aes -> Signal dom (BitVector 128) -> Signal dom (BitVector 128) -> Signal dom (Unsigned 4, Vec 4 (BitVector 32), BitVector 128, Bool) -aes start key block = bundle (cnt, roundKey, pack <$> roundState, cnt .==. 11) +aes start key block = bundle (cnt, roundKey, pack <$> roundState, cnt .== 11) where roundKey :: Signal dom (Vec 4 (BitVector 32)) diff --git a/tests/shouldwork/Issues/T1187/Utils.hs b/tests/shouldwork/Issues/T1187/Utils.hs index 3e7cf42bf1..c72c79134d 100644 --- a/tests/shouldwork/Issues/T1187/Utils.hs +++ b/tests/shouldwork/Issues/T1187/Utils.hs @@ -1,8 +1,6 @@ {-# LANGUAGE ScopedTypeVariables #-} module T1187.Utils - ( (.==) - - , debounce + ( debounce , roundRobin @@ -25,7 +23,7 @@ debounce _ initial this = regEn initial stable this where counter = register (0 :: Index (ClockDivider dom ps)) counter' counter' = mux (unchanged initial this) counter 0 - stable = counter' .==. pure maxBound + stable = counter' .== maxBound roundRobin :: forall n dom. (KnownNat n, HiddenClockResetEnable dom) @@ -33,10 +31,6 @@ roundRobin -> (Signal dom (Vec n Bool), Signal dom (Index n)) roundRobin _next = undefined -infix 4 .== -(.==) :: (Eq a, Functor f) => f a -> a -> f Bool -fx .== y = (== y) <$> fx - moreIdx :: (Eq a, Enum a, Bounded a) => a -> a moreIdx = fromMaybe maxBound . succIdx diff --git a/tests/shouldwork/Xilinx/ClockWizard.hs b/tests/shouldwork/Xilinx/ClockWizard.hs index 6da2795317..b12afaea42 100644 --- a/tests/shouldwork/Xilinx/ClockWizard.hs +++ b/tests/shouldwork/Xilinx/ClockWizard.hs @@ -37,8 +37,8 @@ testBench :: testBench = done where (o1, o2) = unbundle $ topEntity clkSE clkDiff rst - done1 = o1 .==. pure maxBound - done2 = o2 .==. pure maxBound + done1 = o1 .== maxBound + done2 = o2 .== maxBound done = unsafeSynchronizer clockGen clkSE $ fmap endVhdlSim $ strictAnd <$> done1 <*> done2 strictAnd !a !b = a && b