diff --git a/clash-prelude.cabal b/clash-prelude.cabal --- a/clash-prelude.cabal +++ b/clash-prelude.cabal @@ -1,5 +1,5 @@ Name: clash-prelude -Version: 1.0.0 +Version: 1.0.1 Synopsis: CAES Language for Synchronous Hardware - Prelude library Description: Clash is a functional hardware description language that borrows both its @@ -42,7 +42,7 @@ general overview of the library you should however check out "Clash.Prelude". Some circuit examples can be found in "Clash.Examples". Homepage: http://www.clash-lang.org/ -bug-reports: http://github.com/clash-lang/clash-prelude/issues +bug-reports: http://github.com/clash-lang/clash-compiler/issues License: BSD2 License-file: LICENSE Author: The Clash Authors diff --git a/src/Clash/Intel/ClockGen.hs b/src/Clash/Intel/ClockGen.hs --- a/src/Clash/Intel/ClockGen.hs +++ b/src/Clash/Intel/ClockGen.hs @@ -7,6 +7,7 @@ PLL and other clock-related components for Intel (Altera) FPGAs -} +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ExplicitForAll #-} @@ -53,7 +54,7 @@ -- ^ Reset for the PLL -> (Clock domOut, Signal domOut Bool) -- ^ (Stable PLL clock, PLL lock) -altpll _ = clocks +altpll !_ = clocks {-# NOINLINE altpll #-} -- | A clock source that corresponds to the Intel/Quartus \"Altera PLL\" @@ -95,5 +96,5 @@ -> Reset domIn -- ^ Reset for the PLL -> t -alteraPll _ = clocks +alteraPll !_ = clocks {-# NOINLINE alteraPll #-} diff --git a/src/Clash/Signal/Trace.hs b/src/Clash/Signal/Trace.hs --- a/src/Clash/Signal/Trace.hs +++ b/src/Clash/Signal/Trace.hs @@ -26,16 +26,16 @@ mainCounter = traceSignal1 "main" counter where counter = - register 0 (fmap succ' $ bundle (subcounter,counter)) + register 0 (fmap succ' $ bundle (subCounter,counter)) succ' (sc, c) | sc == maxBound = c + 1 | otherwise = c -- | Collect traces, and dump them to a VCD file. -main :: SystemClockResetEnable => IO () +main :: IO () main = do - let cntrOut = exposeClockResetEnable mainCounter systemClockGen systemResetGen + let cntrOut = exposeClockResetEnable mainCounter systemClockGen systemResetGen enableGen vcd <- dumpVCD (0, 100) cntrOut ["main", "sub"] case vcd of Left msg -> @@ -411,36 +411,28 @@ headerWire w l n = map Text.pack ["$var wire", show w, [l], n, "$end"] initValues = map Text.pack $ zipWith ($) formatters inits - -- Guard against (partially) undefined bitvectors: - toIntegers :: Int -> [[Value]] -> [[Integer]] - toIntegers _ [] = [] - toIntegers !cyclen (xs:xss) = - zipWith vToInteger traceNames xs : toIntegers (cyclen + 1) xss - where - vToInteger _traceName (0, v) = v - vToInteger traceName (mask, v) = - error $ "dumpVCD can't handle (partially) undefined values yet, but " - ++ "encountered one at cycle " ++ show cyclen ++ " of traced signal " - ++ "labeled " ++ show traceName ++ ". Mask was " ++ show mask - ++ ", value was " ++ show v ++ "." - formatters = zipWith format widths labels - inits = map head (toIntegers 0 valuess') - tails = map changed (toIntegers 0 valuess') + inits = map head valuess' + tails = map changed valuess' -- | Format single value according to VCD spec - format :: Width -> Char -> Integer -> String - format 1 label 0 = ['0', label, '\n'] - format 1 label 1 = ['1', label, '\n'] - format 1 label val = - error $ "Width of " ++ show label ++ " was " ++ show val - format n label val = - let b2b b = if b then '1' else '0' in - "b" ++ map (b2b . testBit val) (reverse [0..n-1]) ++ " " ++ [label] + format :: Width -> Char -> Value -> String + format 1 label (0,0) = ['0', label, '\n'] + format 1 label (0,1) = ['1', label, '\n'] + format 1 label (1,_) = ['x', label, '\n'] + format 1 label (mask,val) = + error $ "Can't format 1 bit wide value for " ++ show label ++ ": value " ++ show val ++ " and mask " ++ show mask + format n label (mask,val) = + "b" ++ map digit (reverse [0..n-1]) ++ " " ++ [label] + where + digit d = case (testBit mask d, testBit val d) of + (False,False) -> '0' + (False,True) -> '1' + (True,_) -> 'x' -- | Given a list of values, return a list of list of bools indicating -- if a value changed. The first value is *not* included in the result. - changed :: [Integer] -> [(Changed, Integer)] + changed :: [Value] -> [(Changed, Value)] changed (s:ss) = zip (zipWith (/=) (s:ss) ss) ss changed [] = [] @@ -452,7 +444,7 @@ let pre = Text.concat ["#", n, "\n"] in fmap (Text.append pre) t - bodyPart :: [(Changed, Integer)] -> Maybe Text.Text + bodyPart :: [(Changed, Value)] -> Maybe Text.Text bodyPart values = let formatted = [(c, f v) | (f, (c,v)) <- zip formatters values] formatted' = map (Text.pack . snd) $ filter fst $ formatted in diff --git a/src/Clash/Tutorial.hs b/src/Clash/Tutorial.hs --- a/src/Clash/Tutorial.hs +++ b/src/Clash/Tutorial.hs @@ -338,7 +338,7 @@ @ register - ( 'HiddenClockResetEnable' dom dom + ( 'HiddenClockResetEnable' dom , 'Clash.XException.NFDataX' a ) => a -> 'Signal' dom a @@ -427,7 +427,7 @@ @ mealy - :: ('HiddenClockResetEnable' dom dom, 'Clash.XException.NFDataX' s) + :: ('HiddenClockResetEnable' dom, 'Clash.XException.NFDataX' s) => (s -> i -> (s,o)) -> s -> ('Signal' dom i -> 'Signal' dom o) @@ -667,7 +667,7 @@ @ asStateM - :: ( 'HiddenClockResetEnable' dom dom + :: ( 'HiddenClockResetEnable' dom , 'NFDataX' s ) => (i -> 'Control.Monad.State.Lazy.State' s o) -> s @@ -734,9 +734,11 @@ look at the type of 'mealy': @ -__mealy__ :: (s -> i -> (s,o)) - -> s - -> ('Signal' i -> 'Signal' o) +__mealy__ + :: HiddenClockResetEnable dom + => (s -> i -> (s,o)) + -> s + -> ('Signal' dom i -> 'Signal' dom o) @ we see that the resulting function has an input of type @'Signal' i@, and an @@ -762,8 +764,8 @@ The /true/ types of these two functions are, however: @ -__bundle__ :: 'Bundle' a => 'Unbundled' domain a -> 'Signal' dom a -__unbundle__ :: 'Bundle' a => 'Signal' dom a -> 'Unbundled' domain a +__bundle__ :: 'Bundle' a => 'Unbundled' dom a -> 'Signal' dom a +__unbundle__ :: 'Bundle' a => 'Signal' dom a -> 'Unbundled' dom a @ 'Unbundled' is an @@ -786,7 +788,7 @@ @ instance 'Bundle' (a,b) where - type 'Unbundled' domain (a,b) = ('Signal' dom a, 'Signal' dom b) + type 'Unbundled' dom (a,b) = ('Signal' dom a, 'Signal' dom b) bundle (a,b) = (,) '<$>' a '<*>' b unbundle tup = (fst '<$>' tup, snd '<*>' tup) @ @@ -812,8 +814,8 @@ :: ('Bundle' i, 'Bundle' o) => (s -> i -> (s,o)) -> s - -> 'Unbundled' domain i - -> 'Unbundled' domain o + -> 'Unbundled' dom i + -> 'Unbundled' dom o @ Using 'mealyB' we can define @g@ as: @@ -2318,8 +2320,8 @@ dotp as bs = fold boundedPlus (zipWith boundedMult as bs) fir - :: (Default a, KnownNat n, SaturatingNum a, HiddenClockReset domain gated synchronous) - => Vec (n + 1) a -> Signal domain a -> Signal domain a + :: (Default a, KnownNat n, SaturatingNum a, HiddenClockResetEnable dom) + => Vec (n + 1) a -> Signal dom a -> Signal dom a fir coeffs x_t = y_t where y_t = dotp coeffs \<$\> bundle xs diff --git a/src/Clash/XException.hs b/src/Clash/XException.hs --- a/src/Clash/XException.hs +++ b/src/Clash/XException.hs @@ -603,7 +603,7 @@ instance NFDataX a => NFDataX (Down a) where deepErrorX = Down . deepErrorX - rnfX d@(~(Down x))= if isLeft (isX d) then rnfX x else () + rnfX d@(~(Down x)) = if isLeft (isX d) then () else rnfX x instance NFDataX Bool instance NFDataX a => NFDataX [a] diff --git a/src/Clash/Xilinx/ClockGen.hs b/src/Clash/Xilinx/ClockGen.hs --- a/src/Clash/Xilinx/ClockGen.hs +++ b/src/Clash/Xilinx/ClockGen.hs @@ -6,6 +6,7 @@ PLL and other clock-related components for Xilinx FPGAs -} +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ExplicitForAll #-} @@ -53,7 +54,7 @@ -- ^ Reset for the PLL -> (Clock domOut, Enable domOut) -- ^ (Stable PLL clock, PLL lock) -clockWizard _ clk rst = +clockWizard !_ clk rst = (unsafeCoerce clk, unsafeCoerce (toEnable (unsafeToHighPolarity rst))) {-# NOINLINE clockWizard #-} {-# ANN clockWizard hasBlackBox #-} @@ -96,7 +97,7 @@ -- ^ Reset for the PLL -> (Clock domOut, Enable domOut) -- ^ (Stable PLL clock, PLL lock) -clockWizardDifferential _name (Clock _) (Clock _) rst = +clockWizardDifferential !_name (Clock _) (Clock _) rst = (Clock SSymbol, unsafeCoerce (toEnable (unsafeToHighPolarity rst))) {-# NOINLINE clockWizardDifferential #-} {-# ANN clockWizardDifferential hasBlackBox #-} diff --git a/tests/Clash/Tests/NFDataX.hs b/tests/Clash/Tests/NFDataX.hs --- a/tests/Clash/Tests/NFDataX.hs +++ b/tests/Clash/Tests/NFDataX.hs @@ -5,11 +5,12 @@ module Clash.Tests.NFDataX where -import Test.Tasty -import Test.Tasty.HUnit +import Test.Tasty +import Test.Tasty.HUnit -import GHC.Generics (Generic) -import Clash.XException (NFDataX(rnfX), errorX) +import GHC.Generics (Generic) +import Clash.XException (NFDataX(rnfX), errorX) +import Data.Ord (Down (Down)) data Void deriving (Generic, NFDataX) data Unit = Unit deriving (Generic, NFDataX) @@ -64,6 +65,8 @@ , testCase "Either1" $ rnfX (undef :: Either Int Int) @?= () , testCase "Either2" $ rnfX (Left undef :: Either Int Int) @?= () , testCase "Either3" $ rnfX (Right undef :: Either Int Int) @?= () + , testCase "Down1" $ rnfX (Down undef :: Down Int) @?= () + , testCase "Down2" $ rnfX (undef :: Down Int) @?= () ] ]