packages feed

clash-prelude 1.6.1 → 1.6.2

raw patch · 4 files changed

+256/−66 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- Clash.Explicit.BlockRam: instance GHC.Base.Semigroup Clash.Explicit.BlockRam.Conflict

Files

CHANGELOG.md view
@@ -1,4 +1,17 @@ # Changelog for the Clash project++## 1.6.2 *Fed 25th 2022*+Fixed:+  * Clash now compiles for users of Clang - i.e., all macOS users.+  * The `trueDualPortBlockRam` model did not accurately simulate concurrent active ports, thus causing a Haskell/HDL simulation mismatch for `asyncFIFOSynchronizer`.+  * `trueDualPortBlockRam` Haskell/HDL simulation mismatch for port enable.+  * Sometimes `trueDualPortBlockRam` swapped the names of the ports in exception messages. [#2102](https://github.com/clash-lang/clash-compiler/pull/2102)+  * The evaluator rule for unpack{Float,Double}# are now corrected to return boxed float and double instead of unboxed literals. [#2097](https://github.com/clash-lang/clash-compiler/issues/2097)++Changed:+  * The `trueDualPortBlockRam` model now only models read/write conflicts for concurrent active ports+  * The `trueDualPortBlockRam` model now models write/write conflicts for concurrent active ports+ ## 1.6.1 *Feb 11th 2022* Changed:   * We accidentally released `v1.6.0` with the Cabal flag `multiple-hidden` enabled. This is an experimental feature, supposed to be disabled by default for releases. `v1.6.1` disables it again.
clash-prelude.cabal view
@@ -1,6 +1,6 @@ Cabal-version:        2.2 Name:                 clash-prelude-Version:              1.6.1+Version:              1.6.2 Synopsis:             Clash: a functional hardware description language - Prelude library Description:   Clash is a functional hardware description language that borrows both its
src/Clash/Explicit/BlockRam.hs view
@@ -1201,29 +1201,11 @@ data MaybeX a = IsX | IsDefined !a  data Conflict = Conflict-  { cfWrite :: !(MaybeX Bool)+  { cfRWA     :: !(MaybeX Bool) -- ^ Read/Write conflict for output A+  , cfRWB     :: !(MaybeX Bool) -- ^ Read/Write conflict for output B+  , cfWW      :: !(MaybeX Bool) -- ^ Write/Write conflict   , cfAddress :: !(MaybeX Int) } -instance Semigroup Conflict where-  (<>) = mergeConflicts---- | "Stronger" conflict wins:------   * Writes over read---   * Undefineds over anything----mergeConflicts :: Conflict -> Conflict -> Conflict-mergeConflicts conflict1 conflict2 = Conflict-  { cfWrite = mergeWrite (cfWrite conflict1) (cfWrite conflict2)-  , cfAddress = mergeAddress (cfAddress conflict1) (cfAddress conflict2) }- where-  mergeX _ IsX _ = IsX-  mergeX _ _ IsX = IsX-  mergeX f (IsDefined a) (IsDefined b) = IsDefined (f a b)--  mergeWrite a b = mergeX (||) a b-  mergeAddress a b = mergeX const a b- -- [Note: eta port names for trueDualPortBlockRam] -- -- By naming all the arguments and setting the -fno-do-lambda-eta-expansion GHC@@ -1278,9 +1260,12 @@   -- port enable is @False@, it is /undefined/. trueDualPortBlockRam# clkA enA weA addrA datA clkB enB weB addrB datB   | snatToNum @Int (clockPeriod @domA) < snatToNum @Int (clockPeriod @domB)-  = swap (trueDualPortBlockRamModel clkB enB weB addrB datB clkA enA weA addrA datA)+  = swap (trueDualPortBlockRamModel labelB clkB enB weB addrB datB labelA clkA enA weA addrA datA)   | otherwise-  =       trueDualPortBlockRamModel clkA enA weA addrA datA clkB enB weB addrB datB+  =       trueDualPortBlockRamModel labelA clkA enA weA addrA datA labelB clkB enB weB addrB datB+ where+  labelA = "Port A"+  labelB = "Port B" {-# NOINLINE trueDualPortBlockRam# #-} {-# ANN trueDualPortBlockRam# hasBlackBox #-} @@ -1298,12 +1283,14 @@   , NFDataX a   ) => +  String ->   Clock domSlow ->   Signal domSlow Bool ->   Signal domSlow Bool ->   Signal domSlow (Index nAddrs) ->   Signal domSlow a -> +  String ->   Clock domFast ->   Signal domFast Bool ->   Signal domFast Bool ->@@ -1311,21 +1298,26 @@   Signal domFast a ->    (Signal domSlow a, Signal domFast a)-trueDualPortBlockRamModel !_clkA enA weA addrA datA !_clkB enB weB addrB datB =-  ( deepErrorX "trueDualPortBlockRam: Port A: First value undefined" :- outA-  , deepErrorX "trueDualPortBlockRam: Port B: First value undefined" :- outB )+trueDualPortBlockRamModel labelA !_clkA enA weA addrA datA labelB !_clkB enB weB addrB datB =+  ( startA :- outA+  , startB :- outB )  where   (outA, outB) =     go-      Nothing       (Seq.fromFunction (natToNum @nAddrs) initElement)-      tA -- ensure 'go' hits fast clock first+      tB -- ensure 'go' hits fast clock first for 1 cycle, then execute slow+         -- clock for 1 cycle, followed by the regular cadence of 'ceil(tA / tB)'+         -- cycles for the fast clock followed by 1 cycle of the slow clock       (bundle (enA, weA, fromIntegral <$> addrA, datA))       (bundle (enB, weB, fromIntegral <$> addrB, datB))+      startA startB    tA = snatToNum @Int (clockPeriod @domSlow)   tB = snatToNum @Int (clockPeriod @domFast) +  startA = deepErrorX $ "trueDualPortBlockRam: " <> labelA <> ": First value undefined"+  startB = deepErrorX $ "trueDualPortBlockRam: " <> labelB <> ": First value undefined"+   initElement :: Int -> a   initElement n =     deepErrorX ("Unknown initial element; position " <> show n)@@ -1341,24 +1333,25 @@     deepErrorX ("Write enabled, but address unknown; position " <> show n <>                 "\nAddress error message: " <> msg) -  getConflict :: Bool -> Int -> Bool -> Int -> Maybe Conflict-  getConflict enableA addrA_ enableB addrB_ =+  getConflict :: Bool -> Bool -> Bool -> Int -> Bool -> Int -> Maybe Conflict+  getConflict enA_ enB_ wenA addrA_ wenB addrB_ =     -- If port A or port B is writing on (potentially!) the same address,     -- there's a conflict-    if sameAddr then maybeConflict else Nothing+    if sameAddr then Just conflict else Nothing    where+    wenAX = toMaybeX wenA+    wenBX = toMaybeX wenB++    mergeX IsX b = b+    mergeX a IsX = a+    mergeX (IsDefined a) (IsDefined b) = IsDefined (a && b)+     conflict = Conflict-      { cfWrite = toMaybeX enableA+      { cfRWA     = if enB_ then wenBX else IsDefined False+      , cfRWB     = if enA_ then wenAX else IsDefined False+      , cfWW      = if enA_ && enB_ then mergeX wenAX wenBX else IsDefined False       , cfAddress = toMaybeX addrA_ } -    maybeConflict =-      case (isX enableA, isX enableB) of-        (Left _, _)     -> Just conflict-        (Right True, _) -> Just conflict-        (_, Left _)     -> Just conflict-        (_, Right True) -> Just conflict-        _               -> Nothing-     sameAddr =       case (isX addrA_, isX addrB_) of         (Left _, _) -> True@@ -1392,47 +1385,74 @@     addrUndefined = isX addr    go ::-    Maybe Conflict ->     Seq a ->     Int ->     Signal domSlow (Bool, Bool, Int, a) ->     Signal domFast (Bool, Bool, Int, a) ->+    a -> a ->     (Signal domSlow a, Signal domFast a)-  go conflict0 ram0 relativeTime as0 bs0 =-    if relativeTime <= 0 then goSlow else goFast+  go ram0 relativeTime as0 bs0 =+    case compare relativeTime 0 of+      LT -> goSlow+      EQ -> goBoth+      GT -> goFast    where     (enA_, weA_, addrA_, datA_) :- as1 = as0     (enB_, weB_, addrB_, datB_) :- bs1 = bs0 +    goBoth prevA prevB = outA2 `seqX` outB2 `seqX` (outA2 :- as2, outB2 :- bs2)+     where+      conflict = getConflict enA_ enB_ weA_ addrA_ weB_ addrB_++      (datA1_,datB1_) = case conflict of+        Just Conflict{cfWW=IsDefined True} ->+          ( deepErrorX "trueDualPortBlockRam: conflicting write/write queries"+          , deepErrorX "trueDualPortBlockRam: conflicting write/write queries" )+        Just Conflict{cfWW=IsX} ->+          ( deepErrorX "trueDualPortBlockRam: conflicting write/write queries"+          , deepErrorX "trueDualPortBlockRam: conflicting write/write queries" )+        _ -> (datA_,datB_)++      (wroteA,ram1) = writeRam weA_ addrA_ datA1_ ram0+      (wroteB,ram2) = writeRam weB_ addrB_ datB1_ ram1++      outA1 = case conflict of+        Just Conflict{cfRWA=IsDefined True} ->+          deepErrorX "trueDualPortBlockRam: conflicting read/write queries"+        Just Conflict{cfRWA=IsX} ->+          deepErrorX "trueDualPortBlockRam: conflicting read/write queries"+        _ -> fromMaybe (ram0 `Seq.index` addrA_) wroteA++      outB1 = case conflict of+        Just Conflict{cfRWB=IsDefined True} ->+          deepErrorX "trueDualPortBlockRam: conflicting read/write queries"+        Just Conflict{cfRWB=IsX} ->+          deepErrorX "trueDualPortBlockRam: conflicting read/write queries"+        _ -> fromMaybe (ram0 `Seq.index` addrB_) wroteB++      outA2 = if enA_ then outA1 else prevA+      outB2 = if enB_ then outB1 else prevB+      (as2,bs2) = go ram2 (relativeTime - tB + tA) as1 bs1 outA2 outB2+     -- 1 iteration here, as this is the slow clock.-    goSlow = out1 `seqX` (out1 :- as2, bs2)+    goSlow _ prevB | enA_ = out0 `seqX` (out0 :- as2, bs2)      where       (wrote, !ram1) = writeRam weA_ addrA_ datA_ ram0       out0 = fromMaybe (ram1 `Seq.index` addrA_) wrote-      (as2, bs2) = go Nothing ram1 (relativeTime + tA) as1 bs0-      out1 =-        case conflict0 of-          Just Conflict{cfWrite=IsDefined True} ->-            deepErrorX "trueDualPortBlockRam: conflicting read/write queries"-          Just Conflict{cfWrite=IsX} ->-            deepErrorX "trueDualPortBlockRam: conflicting read/write queries"-          _ -> out0+      (as2, bs2) = go ram1 (relativeTime + tA) as1 bs0 out0 prevB +    goSlow prevA prevB = (prevA :- as2, bs2)+      where+        (as2,bs2) = go ram0 (relativeTime + tA) as1 bs0 prevA prevB+     -- 1 or more iterations here, as this is the fast clock. First iteration     -- happens here.-    goFast = out1 `seqX` (as2, out1 :- bs2)+    goFast prevA _ | enB_ = out0 `seqX` (as2, out0 :- bs2)      where-      conflict1 | enA_ && enB_ = getConflict weB_ addrB_ weA_ addrA_-                | otherwise    = Nothing       (wrote, !ram1) = writeRam weB_ addrB_ datB_ ram0       out0 = fromMaybe (ram1 `Seq.index` addrB_) wrote-      conflict2 = conflict0 <> conflict1-      (as2, bs2) = go conflict2 ram1 (relativeTime - tB) as0 bs1-      out1 =-        case conflict1 of-          Just Conflict{cfWrite=IsDefined False} ->-            deepErrorX "trueDualPortBlockRam: conflicting read/write queries"-          Just Conflict{cfWrite=IsX} ->-            deepErrorX "trueDualPortBlockRam: conflicting read/write queries"-          _ ->-            out0+      (as2, bs2) = go ram1 (relativeTime - tB) as0 bs1 prevA out0++    goFast prevA prevB = (as2, prevB :- bs2)+     where+       (as2,bs2) = go ram0 (relativeTime - tB) as0 bs1 prevA prevB
tests/Clash/Tests/AsyncFIFOSynchronizer.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -Wno-orphans #-}@@ -5,9 +7,14 @@  module Clash.Tests.AsyncFIFOSynchronizer (tests) where +import Data.Maybe (isJust, catMaybes) import qualified Prelude as P +import Hedgehog as H+import qualified Hedgehog.Range as Range+import qualified Hedgehog.Gen as Gen import Test.Tasty+import Test.Tasty.Hedgehog import Test.Tasty.HUnit  import Clash.Explicit.Prelude@@ -963,6 +970,155 @@   , (Nothing,False)   ] +createDomain vSystem{vName="A", vPeriod=hzToPeriod 20e6} -- fast+createDomain vSystem{vName="B", vPeriod=hzToPeriod 10e6} -- slow+createDomain vSystem{vName="C", vPeriod=hzToPeriod 7e6} -- slower++data DomProxy (dom :: Domain) where+  DomProxy+    :: KnownDomain dom+    => DomProxy dom++-- A more useful Show instance than the one for 'Proxy'+instance Show (DomProxy dom) where+  showsPrec d dom@DomProxy =+    showParen (d > app_prec) $ ("DomProxy @" <>) . (symbolVal dom <>)+   where app_prec = 10++data NamedTest a = NamedTest+  { namedTest :: a+  , testName :: String+  }++instance Show (NamedTest a) where+  show nt = testName nt++testNameShowsPrec+  :: Int+  -> ShowS+  -> DomProxy dom1+  -> DomProxy dom2+  -> ShowS+testNameShowsPrec d baseName dom1 dom2 =+  showParen (d > app_prec) $ baseName . (' ':) . showsPrec 11 dom1 .+    (' ':) . showsPrec 11 dom2+ where app_prec = 10++forAllNamedTestProperties+  :: [NamedTest (PropertyT IO ())]+  -> Property++forAllNamedTestProperties nts = property $ do+  t <- fmap namedTest . forAllWith show . Gen.resize 99 $ Gen.element nts+  t++data WriteAction =+    Write+  | WNoOp+  | WGated+  | GatedWrite+  deriving (Eq, Enum, Bounded, Show, Generic, NFDataX)++data ReadAction =+    Read+  | RNoOp+  | RGated+  | GatedRead+  deriving (Eq, Enum, Bounded, Show, Generic, NFDataX)++fifoOperations+  :: forall wdom rdom+   . (KnownDomain wdom, KnownDomain rdom)+  => [ReadAction]+  -> [WriteAction]+  -> ( Signal rdom ( Bool+                     -- Test fully done+                   , Maybe Int+                     -- Element read from FIFO+                   )+     , Signal wdom ( Bool+                     -- Test fully done+                   , Maybe Int+                    -- Element written to FIFO+                   )+     )+fifoOperations racts wacts = (bundle (rAllDone, rel), bundle (wAllDone, wel))+ where+  (rdata, rempty, wfull) =+    asyncFIFOSynchronizer d3 wclk rclk noWRst noRRst (toEnable wen)+      (toEnable ren) rinc wDataM+  rclk = clockGen @rdom+  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)+  (wdone, wact) =+    unbundle $ fromList $ P.zip (P.repeat False) wacts <> P.repeat (True, WNoOp)+  (rdone, ract) =+    unbundle $ fromList $ P.zip (P.repeat False) racts <> P.repeat (True, RNoOp)+  (wen, wDataM) = unbundle $+    liftA2 (\wact0 d -> case wact0 of+                          Write      -> (True , Just d )+                          WNoOp      -> (True , Nothing)+                          WGated     -> (False, Nothing)+                          GatedWrite -> (False, Just d )+           ) wact wdata+  wdata = regEn wclk noWRst enableGen 1 (isJust <$> wDataM) (wdata + 1)+  (ren, rinc) = unbundle $+    fmap (\ract0 -> case ract0 of+                      Read       -> (True , True )+                      RNoOp      -> (True , False)+                      RGated     -> (False, False)+                      GatedRead  -> (False, True)+         ) ract1+  mainDone = rdone .&&. unsafeSynchronizer wclk rclk wdone+  -- Empty FIFO after main test+  ract1 = mux mainDone (pure Read) ract+  flushCnt = regEn rclk noRRst enableGen (1 :: Int) mainDone (flushCnt + 1)+  -- Surely in 20 cycles we have seen all of the FIFO even if something has gone+  -- wrong with the pointers+  rAllDone = fmap (> 20) flushCnt+  wAllDone = unsafeSynchronizer rclk wclk rAllDone+  rel = mux (liftA3 (\en inc em -> en && inc && not em) ren rinc rempty)+            (Just <$> rdata) (pure Nothing)+  wel = mux (liftA3 (\en wdm fu -> en && isJust wdm && not fu) wen wDataM wfull)+            (Just <$> wdata) (pure Nothing)++fifoFunctionalTest+  :: forall wdom rdom m+   . Monad m+  => DomProxy wdom+  -> DomProxy rdom+  -> NamedTest (PropertyT m ())+fifoFunctionalTest wdom@DomProxy rdom@DomProxy =+  NamedTest { namedTest=test0, testName = name }+ where+  name = testNameShowsPrec 0 (shows 'fifoFunctionalTest) wdom rdom ""+  genInput :: (Bounded e, Enum e, Show e) => PropertyT m [e]+  genInput = fmap P.concat . forAll . Gen.list (Range.linear 1 10) .+               Gen.list (Range.linear 0 20) $ Gen.enumBounded+  test0 = do+    racts <- genInput+    wacts <- genInput+    let+      results = fifoOperations @wdom @rdom racts wacts+      catValids = catMaybes . P.map snd . P.takeWhile (not . fst)+      rels = catValids . sample $ fst results+      wels = catValids . sample $ snd results+    rels === wels++fifoFunctionalTestCombinations :: Monad m => [NamedTest (PropertyT m ())]+fifoFunctionalTestCombinations =+  [ fifoFunctionalTest (DomProxy @A) (DomProxy @A)+  , fifoFunctionalTest (DomProxy @A) (DomProxy @B)+  , fifoFunctionalTest (DomProxy @A) (DomProxy @C)+  , fifoFunctionalTest (DomProxy @B) (DomProxy @A)+  , fifoFunctionalTest (DomProxy @B) (DomProxy @C)+  , fifoFunctionalTest (DomProxy @C) (DomProxy @A)+  , fifoFunctionalTest (DomProxy @C) (DomProxy @B)+  ]+ tests :: TestTree tests = testGroup "asyncFIFOSynchronizer"   [ testCase "Test 1.1 Read" test1R1@@ -993,4 +1149,5 @@   , testCase "Test 5.7 Write" test5W7   , testCase "Test 6.7 Read" test6R7   , testCase "Test 6.7 Write" test6W7+  , testProperty "Functional test" $ forAllNamedTestProperties fifoFunctionalTestCombinations   ]