From 0dea9cd792269e2060844e955a987a7b0e3fa864 Mon Sep 17 00:00:00 2001 From: Peter Lebbing Date: Sat, 11 Mar 2023 13:12:01 +0100 Subject: [PATCH] Generalize period<->frequency conversion, use (#2436) `periodToHz`, `hzToPeriod`, `fsToHz` and `hzToFs` can be generalized so they can be more easily used in cases where we don't want `Natural` and `Ratio Natural` as the types. However, the common use of `vPeriod=hzToPeriod 33e6` means we want the argument to `hzToPeriod` to be monomorphic. Making it polymorphic means it defaults to the inferior `Double` and warns about this defaulting. So we merely generalize the return types of these functions. These functions used to throw exceptions without call stacks when called with zero. By changing that to `ErrorCall` we can get a stack trace, solving an immense frustration in debugging a Clash design. Currently, the frequency calculation in for the Intel PLLs depends on the unit of the period of a `KnownDomain` (picoseconds). If this unit is to be changed internally in the future (to femtoseconds), this calculation would produce the wrong frequency. By using `periodToHz`, the unit of the period no longer matters and can be changed internally. This use case is what prompted this PR. Harmonized and slightly improved some documentation. --- ...-03-09T17_04_39+01_00_generalize_freqtools | 6 ++ .../src/Clash/Primitives/Intel/ClockGen.hs | 7 +- clash-prelude/src/Clash/Signal/Internal.hs | 99 +++++++++++++------ clash-prelude/tests/Clash/Tests/Signal.hs | 11 ++- 4 files changed, 83 insertions(+), 40 deletions(-) create mode 100644 changelog/2023-03-09T17_04_39+01_00_generalize_freqtools diff --git a/changelog/2023-03-09T17_04_39+01_00_generalize_freqtools b/changelog/2023-03-09T17_04_39+01_00_generalize_freqtools new file mode 100644 index 0000000000..a9521c8cea --- /dev/null +++ b/changelog/2023-03-09T17_04_39+01_00_generalize_freqtools @@ -0,0 +1,6 @@ +CHANGED: Generalized the return types of `periodToHz` and `hzToPeriod`. Use a +type application (`periodToHz @(Ratio Natural)`, `hzToPeriod @Natural`) to get +the old behavior back, in case type errors arise. +CHANGED: `periodToHz` and `hzToPeriod` now throw an `ErrorCall` with call stack +when called with the argument 0 (zero), instead of a `RatioZeroDenominator :: +ArithException`. diff --git a/clash-lib/src/Clash/Primitives/Intel/ClockGen.hs b/clash-lib/src/Clash/Primitives/Intel/ClockGen.hs index 54fc6f0e5f..b14c261ca7 100644 --- a/clash-lib/src/Clash/Primitives/Intel/ClockGen.hs +++ b/clash-lib/src/Clash/Primitives/Intel/ClockGen.hs @@ -1,6 +1,6 @@ {-| Copyright : (C) 2018 , Google Inc., - 2021-2022, QBayLogic B.V. + 2021-2023, QBayLogic B.V., 2022 , Google Inc. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. @@ -19,6 +19,7 @@ import Clash.Netlist.BlackBox.Util import qualified Clash.Netlist.Id as Id import Clash.Netlist.Types import Clash.Netlist.Util +import Clash.Signal (periodToHz) import Control.Monad.State import Data.Monoid (Ap(getAp)) @@ -166,7 +167,7 @@ altpllQsysTemplate bbCtx = case bbInputs bbCtx of , KnownDomain _ clkOutPeriod _ _ _ _ <- kdOut -> let clkOutFreq :: Double - clkOutFreq = (1.0 / (fromInteger clkOutPeriod * 1.0e-12)) / 1e6 + clkOutFreq = periodToHz (fromIntegral clkOutPeriod) / 1e6 clklcm = lcm clkInPeriod clkOutPeriod clkmult = clklcm `quot` clkOutPeriod clkdiv = clklcm `quot` clkInPeriod @@ -267,7 +268,7 @@ alteraPllQsysTemplate bbCtx = case bbInputs bbCtx of _ -> error "internal error: not a Product or KnownDomain" cklFreq (KnownDomain _ p _ _ _ _) - = (1.0 / (fromInteger p * 1.0e-12 :: Double)) / 1e6 + = periodToHz (fromIntegral p) / 1e6 :: Double cklFreq _ = error "internal error: not a KnownDomain" clkOuts = TextS.intercalate "\n" diff --git a/clash-prelude/src/Clash/Signal/Internal.hs b/clash-prelude/src/Clash/Signal/Internal.hs index df2cef43e0..2d5946c664 100644 --- a/clash-prelude/src/Clash/Signal/Internal.hs +++ b/clash-prelude/src/Clash/Signal/Internal.hs @@ -2,7 +2,7 @@ Copyright : (C) 2013-2016, University of Twente, 2017-2019, Myrtle Software Ltd 2017-2022, Google Inc., - 2021-2022, QBayLogic B.V. + 2021-2023, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. -} @@ -172,7 +172,7 @@ import Data.Proxy (Proxy(..)) import Data.Ratio (Ratio) import Data.Type.Equality ((:~:)) import GHC.Generics (Generic) -import GHC.Stack (HasCallStack) +import GHC.Stack (HasCallStack, withFrozenCallStack) import GHC.TypeLits (KnownSymbol, Nat, Symbol, type (<=), sameSymbol) import Language.Haskell.TH.Syntax -- (Lift (..), Q, Dec) import Language.Haskell.TH.Compat @@ -195,6 +195,8 @@ import Clash.XException >>> import Clash.Signal.Internal >>> import Clash.Promoted.Nat >>> import Clash.XException +>>> import Data.Ratio (Ratio) +>>> import Numeric.Natural (Natural) >>> type System = "System" >>> let systemClockGen = clockGen @System >>> let systemResetGen = resetGen @System @@ -964,18 +966,17 @@ dynamicClockGen :: KnownDomain dom => -- | Clock period in /femto/seconds. -- - -- __N.B.__: Beware that the periods are given in femtoseconds; this differs + -- * __NB__: Beware that the periods are given in femtoseconds; this differs -- from the usual unit Clash uses to represent period length, -- picoseconds. -- - -- __N.B.__: Beware that not all simulators support femtoseconds. For example, + -- * __NB__: Beware that not all simulators support femtoseconds. For example, -- Vivado's XSIM will round down to nearest picoseconds. -- - -- __N.B.__: Beware that, by default, Clash will define @`timescale 100fs/100fs@ + -- * __NB__: Beware that, by default, Clash will define @`timescale 100fs/100fs@ -- in its generated Verilog. The latter will make simulators round -- time to 100fs. If you rely on more precision you should pass -- @-fclash-timescale-precision 1fs@ to Clash. - -- Signal dom Femtoseconds -> Clock dom dynamicClockGen periods = tbDynamicClockGen periods (pure True) @@ -995,18 +996,17 @@ tbDynamicClockGen :: KnownDomain dom => -- | Clock period in /femto/seconds. -- - -- __N.B.__: Beware that the periods are given in femtoseconds; this differs + -- * __NB__: Beware that the periods are given in femtoseconds; this differs -- from the usual unit Clash uses to represent period length, -- picoseconds. -- - -- __N.B.__: Beware that not all simulators support femtoseconds. For example, + -- * __NB__: Beware that not all simulators support femtoseconds. For example, -- Vivado's XSIM will round down to nearest picoseconds. -- - -- __N.B.__: Beware that, by default, Clash will define @`timescale 100fs/100fs@ + -- * __NB__: Beware that, by default, Clash will define @`timescale 100fs/100fs@ -- in its generated Verilog. The latter will make simulators round -- time to 100fs. If you rely on more precision you should pass -- @-fclash-timescale-precision 1fs@ to Clash. - -- Signal dom Femtoseconds -> Signal dom Bool -> Clock dom @@ -1586,53 +1586,88 @@ fromList_lazy = Prelude.foldr (:-) (error "finite list") simulate_lazy :: (Signal dom1 a -> Signal dom2 b) -> [a] -> [b] simulate_lazy f = sample_lazy . f . fromList_lazy --- | Calculate the period, in __ps__, given a frequency in __Hz__ +-- | Calculate the period in __ps__, given a frequency in __Hz__ -- --- i.e. to calculate the clock period for a circuit to run at 240 MHz we get +-- I.e., to calculate the clock period for a circuit to run at 240 MHz we get -- -- >>> hzToPeriod 240e6 -- 4166 -- --- __NB__: This function is /not/ synthesizable +-- If the value @hzToPeriod@ is applied to is not of the type 'Ratio' +-- 'Natural', you can use @hzToPeriod ('realToFrac' f)@. Note that if @f@ is +-- negative, @realToFrac@ will give an @'Control.Exception.Underflow' :: +-- t'Control.Exception.ArithException'@ without a call stack, making debugging +-- cumbersome. +-- +-- Before Clash 1.8, this function always returned a 'Natural'. To get the old +-- behavior of this function, use a type application: +-- +-- >>> hzToPeriod @Natural 240e6 +-- 4166 -- --- __NB__: This function is lossy. I.e., periodToHz . hzToPeriod /= id. -hzToPeriod :: HasCallStack => Ratio Natural -> Natural -hzToPeriod freq = floor ((1.0 / freq) / 1.0e-12) +-- * __NB__: This function is not synthesizable +-- * __NB__: This function is lossy. I.e., @periodToHz . hzToPeriod /= id@. +hzToPeriod :: (HasCallStack, Integral a) => Ratio Natural -> a +hzToPeriod freq + | freq > 0 = floor ((1.0 / freq) / 1e-12) + | otherwise = withFrozenCallStack $ error "Zero frequency" --- | Calculate the period, in __fs__, given a frequency in __Hz__ +-- | Calculate the period in __fs__, given a frequency in __Hz__ -- --- i.e. to calculate the clock period for a circuit to run at 240 MHz we get +-- I.e., to calculate the clock period for a circuit to run at 240 MHz we get -- -- >>> hzToFs 240e6 -- Femtoseconds 4166666 -- --- __NB__: This function is /not/ synthesizable +-- If the value @hzToFs@ is applied to is not of the type 'Ratio' 'Natural', you +-- can use @hzToFs ('realToFrac' f)@. Note that if @f@ is negative, @realToFrac@ +-- will give an @'Control.Exception.Underflow' :: +-- t'Control.Exception.ArithException'@ without a call stack, making debugging +-- cumbersome. -- --- __NB__: This function is lossy. I.e., fsToHz . hzToFs /= id. +-- * __NB__: This function is not synthesizable +-- * __NB__: This function is lossy. I.e., @fsToHz . hzToFs /= id@. hzToFs :: HasCallStack => Ratio Natural -> Femtoseconds -hzToFs freq = Femtoseconds (floor ((1.0 / freq) / 1.0e-15)) +hzToFs freq + | freq > 0 = Femtoseconds (floor ((1.0 / freq) / 1e-15)) + | otherwise = withFrozenCallStack $ error "Zero frequency" --- | Calculate the frequence in __Hz__, given the period in __ps__ +-- | Calculate the frequency in __Hz__, given the period in __ps__ -- --- i.e. to calculate the clock frequency of a clock with a period of 5000 ps: +-- I.e., to calculate the clock frequency of a clock with a period of 5000 ps: -- -- >>> periodToHz 5000 +-- 2.0e8 +-- +-- Note that if @p@ in @periodToHz ('fromIntegral' p)@ is negative, +-- @fromIntegral@ will give an @'Control.Exception.Underflow' :: +-- t'Control.Exception.ArithException'@ without a call stack, making debugging +-- cumbersome. +-- +-- Before Clash 1.8, this function always returned a 'Ratio' +-- 'Natural'. To get the old behavior of this function, use a type application: +-- +-- >>> periodToHz @(Ratio Natural) 5000 -- 200000000 % 1 -- --- __NB__: This function is /not/ synthesizable -periodToHz :: Natural -> Ratio Natural -periodToHz period = 1.0 / (1.0e-12 * fromIntegral period) +-- __NB__: This function is not synthesizable +periodToHz :: (HasCallStack, Fractional a) => Natural -> a +periodToHz period + | period > 0 = fromRational $ 1.0 / (fromIntegral period * 1e-12) + | otherwise = withFrozenCallStack $ error "Zero period" --- | Calculate the frequence in __Hz__, given the period in __fs__ +-- | Calculate the frequency in __Hz__, given the period in __fs__ -- --- i.e. to calculate the clock frequency of a clock with a period of 5000 fs: +-- I.e., to calculate the clock frequency of a clock with a period of 5000 fs: -- -- >>> fsToHz (Femtoseconds 5000) --- 200000000000 % 1 +-- 2.0e11 -- --- __NB__: This function is /not/ synthesizable -fsToHz :: Femtoseconds -> Ratio Natural -fsToHz (Femtoseconds period) = 1.0 / (1.0e-15 * fromIntegral period) +-- __NB__: This function is not synthesizable +fsToHz :: (HasCallStack, Fractional a) => Femtoseconds -> a +fsToHz (Femtoseconds period) + | period > 0 = fromRational $ 1.0 / (fromIntegral period * 1e-15) + | otherwise = withFrozenCallStack $ error "Zero period" -- | Build an 'Automaton' from a function over 'Signal's. -- diff --git a/clash-prelude/tests/Clash/Tests/Signal.hs b/clash-prelude/tests/Clash/Tests/Signal.hs index 54cb18aee9..b2b6a7c420 100644 --- a/clash-prelude/tests/Clash/Tests/Signal.hs +++ b/clash-prelude/tests/Clash/Tests/Signal.hs @@ -1,8 +1,9 @@ {-| Copyright : (C) 2019, Myrtle Software Ltd 2022, Google Inc. + 2023, QBayLogic B.V. License : BSD2 (see the file LICENSE) -Maintainer : Christiaan Baaij +Maintainer : QBayLogic B.V. -} {-# LANGUAGE CPP #-} @@ -221,8 +222,8 @@ case_dynamicStaticEq = do -- We construct periods in a roundabout way (i.e., using 'hzToPeriod' instead -- of using 'hzToFs'), to prevent rounding errors between periods of the -- static clocks and the periods of the dynamic clocks. - fs11 = Femtoseconds (fromIntegral (1000 * hzToPeriod 11)) - fs77 = Femtoseconds (fromIntegral (1000 * hzToPeriod 77)) + fs11 = Femtoseconds (1000 * hzToPeriod 11) + fs77 = Femtoseconds (1000 * hzToPeriod 77) dclk11 = dynamicClockGen @H11 (pure fs11) dclk77 = dynamicClockGen @H77 (pure fs77) @@ -249,8 +250,8 @@ case_dynamicHasEffect = do -- We construct periods in a roundabout way (i.e., using 'hzToPeriod' instead -- of using 'hzToFs'), to prevent rounding errors between periods of the -- static clocks and the periods of the dynamic clocks. - fs11 = Femtoseconds (fromIntegral (1000 * hzToPeriod 11)) - fs77lying = Femtoseconds (fromIntegral (1000 * hzToPeriod 78)) + fs11 = Femtoseconds (1000 * hzToPeriod 11) + fs77lying = Femtoseconds (1000 * hzToPeriod 78) clk11 = clockGen @H11 clk77 = clockGen @H77