Processed reviewer comments

bittide/bittide.cabal

@@ -96,6 +96,7 @@ test-suite unittests
     Tests.DoubleBufferedRAM
     Tests.ScatterGather
     Tests.Switch
+    Tests.Shared
   default-extensions:
     ImplicitPrelude
   build-depends:

bittide/src/Bittide/ScatterGather.hs

@@ -5,7 +5,12 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE RecordWildCards #-}
-module Bittide.ScatterGather(scatterEngine, gatherEngine, scatterGatherEngine, scatterUnitWB, gatherUnitWB) where
+module Bittide.ScatterGather
+  ( scatterEngine
+  , gatherEngine
+  , scatterGatherEngine
+  , scatterUnitWB
+  , gatherUnitWB) where
 
 import Clash.Prelude
 
@@ -65,7 +70,10 @@ gatherEngine newMetaCycle frameIn readAddr =
     writeAddr = register 0 $ satSucc SatWrap <$> writeAddr
     writeFrame = combineFrameWithAddr frameIn writeAddr
 
-combineFrameWithAddr :: Signal dom (Maybe dat) -> Signal dom addr -> Signal dom (Maybe (addr,dat))
+combineFrameWithAddr ::
+  Signal dom (Maybe dat) ->
+  Signal dom addr ->
+  Signal dom (Maybe (addr,dat))
 combineFrameWithAddr frameIn writeAddr = combine <$> frameIn <*> writeAddr
   where
     combine :: Maybe dat -> addr -> Maybe (addr,dat)
@@ -77,8 +85,16 @@ combineFrameWithAddr frameIn writeAddr = combine <$> frameIn <*> writeAddr
 -- If the read address for the scatter engine is 0, a null frame (Nothing) will be sent to the switch.
 scatterGatherEngine ::
   forall dom calDepthG calDepthS memDepthG memDepthS frameWidth .
-  (HiddenClockResetEnable dom, KnownNat calDepthG, KnownNat calDepthS, KnownNat memDepthG, KnownNat memDepthS, KnownNat frameWidth,
-  1 <= calDepthG , 1 <= calDepthS, 1 <= memDepthG, 1 <= memDepthS) =>
+  ( HiddenClockResetEnable dom
+  , KnownNat calDepthG
+  , KnownNat calDepthS
+  , KnownNat memDepthG
+  , KnownNat memDepthS
+  , KnownNat frameWidth
+  , 1 <= calDepthG
+  , 1 <= calDepthS
+  , 1 <= memDepthG
+  , 1 <= memDepthS) =>
   -- | Bootstrap calendar gather memory.
   Calendar calDepthS memDepthS ->
   -- | Bootstrap calendar scatter memory.
@@ -114,7 +130,9 @@ scatterGatherEngine bootCalS bootCalG scatterConfig gatherConfig
     writeFramePE = (\f a -> fmap (a,) f) <$> frameInPE' <*> writeAddrPE
     gatherOut = doubleBufferedRAM (deepErrorX "gatherOut undefined")
       newMetaCycleG readAddrSwitch writeFramePE
-    toSwitch  = mux (register True $ (==0) <$> readAddrSwitch) (pure Nothing) $ Just <$> gatherOut
+    toSwitch =
+      mux (register True $ (==0) <$> readAddrSwitch)
+      (pure Nothing) $ Just <$> gatherOut
 
 
 -- | Doublebuffered memory component that can be written to by a Bittide link, write address
@@ -193,7 +211,8 @@ wbInterface ::
   Bytes bytes ->
   -- | (slave - master data, read address memory element, write data memory element)
   (WishboneS2M bytes, Index addresses, Maybe (Bytes bytes))
-wbInterface addressRange WishboneM2S{..} readData =  (WishboneS2M{readData, acknowledge, err}, memAddr, writeOp)
+wbInterface addressRange WishboneM2S{..} readData =
+  (WishboneS2M{readData, acknowledge, err}, memAddr, writeOp)
  where
   masterActive = strobe && busCycle
   (alignedAddress, alignment) = split @_ @(addressWidth - 2) @2 addr
@@ -210,7 +229,11 @@ wbInterface addressRange WishboneM2S{..} readData =  (WishboneS2M{readData, ackn
 -- of the read data.
 scatterUnitWB ::
   forall dom memDepth awSU bsCal awCal .
-  (HiddenClockResetEnable dom, KnownNat memDepth, 1 <= memDepth, KnownNat awSU, 2 <= awSU) =>
+  ( HiddenClockResetEnable dom
+  , KnownNat memDepth
+  , 1 <= memDepth
+  , KnownNat awSU
+  , 2 <= awSU) =>
   -- | Initial contents of both memory buffers.
   Vec memDepth (BitVector 64) ->
   -- | Configuration for the calendar.
@@ -225,20 +248,26 @@ scatterUnitWB ::
   Signal dom (WishboneM2S 4 awSU) ->
   -- | (slave - master data scatterUnit , slave - master data calendar)
   (Signal dom (WishboneS2M 4), Signal dom (WishboneS2M bsCal))
-scatterUnitWB initMem calConfig wbInCal calSwitch linkIn wbInSU = (delayControls wbOutSU, wbOutCal)
+scatterUnitWB initMem calConfig wbInCal calSwitch linkIn wbInSU =
+  (delayControls wbOutSU, wbOutCal)
  where
   (wbOutSU, memAddr, _) = unbundle $ wbInterface maxBound <$> wbInSU <*> scatteredData
   (readAddr, upperSelected) = unbundle $ coerceIndexes <$> memAddr
-  (scatterUnitRead, wbOutCal) = scatterUnit initMem calConfig wbInCal calSwitch linkIn readAddr
-  (upper, lower) = unbundle $ split <$> scatterUnitRead
-  scatteredData = mux (register (errorX "scatterUnitWB: Initial selection undefined") upperSelected) upper lower
+  (scatterOut, wbOutCal) = scatterUnit initMem calConfig wbInCal calSwitch linkIn readAddr
+  (upper, lower) = unbundle $ split <$> scatterOut
+  selectedOnReset = errorX "scatterUnitWB: Initial selection undefined"
+  scatteredData = mux (register selectedOnReset upperSelected) upper lower
 
 -- | Wishbone addressable gatherUnit, the wishbone port can write data to this
 -- memory element as if it has a 32 bit port by controlling the byte enables of the
 -- gatherUnit based on the third bit.
 gatherUnitWB ::
   forall dom memDepth awSU bsCal awCal .
-  (HiddenClockResetEnable dom, KnownNat memDepth, 1 <= memDepth, KnownNat awSU, 2 <= awSU) =>
+  ( HiddenClockResetEnable dom
+  , KnownNat memDepth
+  , 1 <= memDepth
+  , KnownNat awSU
+  , 2 <= awSU) =>
   -- | Initial contents of both memory buffers.
   Vec memDepth (BitVector 64) ->
   -- | Configuration for the calendar.
@@ -251,16 +280,21 @@ gatherUnitWB ::
   Signal dom (WishboneM2S 4 awSU) ->
   -- | (slave - master data gatherUnit , slave - master data calendar)
   (Signal dom (DataLink 64), Signal dom (WishboneS2M 4), Signal dom (WishboneS2M bsCal))
-gatherUnitWB initMem calConfig wbInCal calSwitch wbInSU = (linkOut, delayControls wbOutSU, wbOutCal)
+gatherUnitWB initMem calConfig wbInCal calSwitch wbInSU =
+  (linkOut, delayControls wbOutSU, wbOutCal)
  where
   (wbOutSU, memAddr, writeOp) = unbundle $ wbInterface maxBound <$> wbInSU <*> pure 0b0
   (writeAddr, upperSelected) = unbundle $ coerceIndexes <$> memAddr
-  (linkOut, wbOutCal) = gatherUnit initMem calConfig wbInCal calSwitch gatherWrite gatherByteEnables
+  (linkOut, wbOutCal) =
+    gatherUnit initMem calConfig wbInCal calSwitch gatherWrite gatherByteEnables
   gatherWrite = mkWrite <$> writeAddr <*> writeOp
   gatherByteEnables = mkEnables <$> upperSelected <*> (busSelect <$> wbInSU)
+
   mkWrite address (Just write) = Just (address, write ++# write)
   mkWrite _ _ = Nothing
-  mkEnables selected byteEnables = if selected then byteEnables ++# 0b0 else 0b0 ++# byteEnables
+  mkEnables selected byteEnables
+    | selected  = byteEnables ++# 0b0
+    | otherwise = 0b0 ++# byteEnables
 
 -- | Coerces an index of size (n*2) to index n with the lower bit as seperate boolean.
 coerceIndexes :: forall n . (KnownNat n, 1 <= n) => (Index (n*2) -> (Index n, Bool))
@@ -269,7 +303,7 @@ coerceIndexes = case sameNat natA natB of
   _ -> error "gatherUnitWB: Index coercion failed."
   where
   natA = Proxy @(CLog 2 (n*2))
-  natB = Proxy @(CLog 2 n + 1)
+  natB = Proxy @(1 + (CLog 2 n))
 
 -- | Delays the output controls to align them with the actual read / write timing.
 delayControls :: HiddenClockResetEnable dom =>
@@ -278,4 +312,5 @@ delayControls wbIn = wbOut
  where
    delayedAck = register False (acknowledge <$> wbIn)
    delayedErr = register False (err <$> wbIn)
-   wbOut = (\wb newAck newErr-> wb{acknowledge = newAck, err = newErr}) <$> wbIn <*> delayedAck <*> delayedErr
+   wbOut = (\wb newAck newErr-> wb{acknowledge = newAck, err = newErr})
+    <$> wbIn <*> delayedAck <*> delayedErr

bittide/tests/Tests/Calendar.hs

@@ -20,6 +20,8 @@ import Clash.Hedgehog.Sized.Vector
 
 import Bittide.Calendar
 import Bittide.SharedTypes
+import Tests.Shared
+
 import Clash.Sized.Vector (unsafeFromList)
 import Contranomy.Wishbone
 import Data.Constraint
@@ -67,18 +69,6 @@ instance Show (BVCalendar addressWidth) where
 
 deriving instance Show (SNatLE a b)
 
-data IsInBounds a b c where
-  InBounds :: (a <= b, b <= c) => IsInBounds a b c
-  NotInBounds :: IsInBounds a b c
-
-deriving instance Show (IsInBounds a b c)
-
--- | Returns 'InBounds' if a <= b <= c, otherwise returns 'NotInBounds'.
-isInBounds :: SNat a -> SNat b -> SNat c -> IsInBounds a b c
-isInBounds a b c = case (compareSNat a b, compareSNat b c) of
-  (SNatLE, SNatLE) -> InBounds
-  _ -> NotInBounds
-
 -- | Generates a configuration for 'Bittide.Calendar.calendarWB', with as first argument
 -- the maximum depth of the stored calendar and as second argument a generator for the
 -- calendar entries.

bittide/tests/Tests/ScatterGather.hs

@@ -34,6 +34,7 @@ import Bittide.ScatterGather
 import Bittide.Calendar
 import Data.Maybe
 import Bittide.SharedTypes
+import Tests.Shared
 
 isUndefined :: forall n . KnownNat n => BitVector n -> Bool
 isUndefined (BV mask _) = mask == full
@@ -168,21 +169,9 @@ scatterGatherNoFrameLoss = property $ do
 
       expected === result
 
-
+-- TODO: Remove instance once Clash.Prelude has it.
 deriving instance Show (SNatLE a b)
 
-data IsInBounds a b c where
-  InBounds :: (a <= b, b <= c) => IsInBounds a b c
-  NotInBounds :: IsInBounds a b c
-
-deriving instance Show (IsInBounds a b c)
-
--- | Returns 'InBounds' when a <= b <= c, otherwise returns 'NotInBounds'.
-isInBounds :: SNat a -> SNat b -> SNat c -> IsInBounds a b c
-isInBounds a b c = case (compareSNat a b, compareSNat b c) of
-  (SNatLE, SNatLE) -> InBounds
-  _ -> NotInBounds
-
 -- | Generates a 'CalendarConfig' for the 'gatherUnitWB' or 'scatterUnitWB'
 genCalendarConfig ::
   forall bytes addressWidth calEntry maxDepth .
@@ -210,8 +199,9 @@ genCalendarConfig sizeNat@(snatToNum -> dMax) = do
          , compareSNat d1 bsCalEntry) of
           (InBounds, InBounds, SNatLE, SNatLE)-> go depthA depthB
           (a,b,c,d) -> error $ "genCalendarConfig: calEntry constraints not satisfied: ("
-           <> show a <> ", " <> show b <> ", " <> show c <> ", "  <> show d <> "), \n(depthA, depthB, maxDepth, calEntry bitsize) = ("
-           <> show depthA <> ", " <> show depthB <> ", " <> show sizeNat <> ", " <> show bsCalEntry <> ")"
+           <> show a <> ", " <> show b <> ", " <> show c <> ", "  <> show d <>
+           "), \n(depthA, depthB, maxDepth, calEntry bitsize) = (" <> show depthA <> ", "
+           <> show depthB <> ", " <> show sizeNat <> ", " <> show bsCalEntry <> ")"
  where
     go :: forall depthA depthB .
       ( LessThan depthA maxDepth
@@ -222,8 +212,9 @@ genCalendarConfig sizeNat@(snatToNum -> dMax) = do
       Gen (CalendarConfig bytes addressWidth (Index maxDepth))
     go SNat SNat = do
       calActive <- fromMaybe errmsg . fromList @depthA . P.take (natToNum @depthA)
-       <$> Gen.shuffle @_ @(Index maxDepth) [0.. natToNum @(maxDepth-1)]
-      calShadow <- fromMaybe errmsg . fromList @depthB . P.take (natToNum @depthB) <$> Gen.shuffle @_ @(Index maxDepth) [0.. natToNum @(maxDepth-1)]
+        <$> Gen.shuffle @_ @(Index maxDepth) [0.. natToNum @(maxDepth-1)]
+      calShadow <- fromMaybe errmsg . fromList @depthB . P.take (natToNum @depthB)
+        <$> Gen.shuffle @_ @(Index maxDepth) [0.. natToNum @(maxDepth-1)]
       return $ CalendarConfig sizeNat calActive calShadow
     errmsg = errorX "genCalendarConfig: list to vector conversion failed"
 

bittide/tests/Tests/Shared.hs

@@ -0,0 +1,20 @@
+-- SPDX-FileCopyrightText: 2022 Google LLC
+--
+-- SPDX-License-Identifier: Apache-2.0
+
+{-# LANGUAGE GADTs #-}
+module Tests.Shared where
+
+import Clash.Prelude
+
+data IsInBounds a b c where
+  InBounds :: (a <= b, b <= c) => IsInBounds a b c
+  NotInBounds :: IsInBounds a b c
+
+deriving instance Show (IsInBounds a b c)
+
+-- | Returns 'InBounds' when a <= b <= c, otherwise returns 'NotInBounds'.
+isInBounds :: SNat a -> SNat b -> SNat c -> IsInBounds a b c
+isInBounds a b c = case (compareSNat a b, compareSNat b c) of
+  (SNatLE, SNatLE) -> InBounds
+  _ -> NotInBounds