Optimize buffer (#44)

standardsemiconductor · Aug 15, 2024 · 1af51c0 · 1af51c0
1 parent f35d3ad
commit 1af51c0
Show file tree

Hide file tree

Showing 4 changed files with 862 additions and 950 deletions.
diff --git a/lib/Bayeux/Buffer.hs b/lib/Bayeux/Buffer.hs
@@ -1,7 +1,6 @@
 {-# LANGUAGE FlexibleInstances    #-}
 {-# LANGUAGE InstanceSigs         #-}
 {-# LANGUAGE OverloadedLists      #-}
-{-# LANGUAGE OverloadedStrings    #-}
 {-# LANGUAGE ScopedTypeVariables  #-}
 
 module Bayeux.Buffer
@@ -11,14 +10,13 @@ module Bayeux.Buffer
   ) where
 
 import Bayeux.Cell hiding (le)
-import qualified Bayeux.Cell as C
 import Bayeux.Encode
 import Bayeux.Rtl (Rtl)
-import Bayeux.Signal hiding (sliceIx)
+import Bayeux.Signal
 import Bayeux.Width
 import Data.Array
 import Data.Finite
-import Data.String
+import Data.Proxy
 import GHC.TypeNats
 import Yosys.Rtl
 
@@ -54,29 +52,21 @@ instance MonadBuffer Rtl where
       , elsem $ pure i
       ]
     isFull <- i === sig maxBound
-    b <- process $ \b -> do
-      let shiftedBuf = sliceRotate 1 b
-          la = fromIntegral $ width (undefined :: Array (Finite n) e)
-          le = fromIntegral w
-          input' :: Sig (Array (Finite n) e)
-          input' = Sig $ mconcat
+    b <- process $ \(b :: Sig (Array (Finite n) e)) -> do
+      let bLength :: Integer
+          bLength = fromIntegral $ natVal (Proxy :: Proxy n)
+          ixs :: [Finite n]
+          ixs = finite <$> reverse [1..bLength - 1]
+          b' :: Sig (Array (Finite n) e)
+          b' = Sig $ mconcat
             [ spec $ sliceValue inp
-            , fromString $ show (la - le) <> "'" <> replicate (la - le) '0'
+            , foldMap (spec . flip sliceIx b) ixs
             ]
-          mask :: Sig (Array (Finite n) e)
-          mask  = let zs = replicate le '0'
-                      ones = replicate (la - le) '1'
-                  in fromString $ show la <> "'" <> zs <> ones
-      maskedBuf <- shiftedBuf `C.and` mask
-      buf' <- input' `C.or` maskedBuf
-      ifs [ sliceValid inp `thens` buf'
+      ifs [ sliceValid inp `thens` b'
           , elses b
           ]
     isValid' <- process $ const $ isFull `logicAnd` sliceValid inp
     return $ toMaybeSig isValid' b
-    where
-      w :: Integer
-      w = width (undefined :: e)
 
   cobuffer
     :: forall e n
@@ -87,7 +77,7 @@ instance MonadBuffer Rtl where
     -> Rtl (Sig (Maybe e))
   cobuffer a = fmap snd $ machine $ \s -> do
     let fsmSig = sliceFsm s
-        ixSig  = sliceIx  s
+        ixSig  = sliceCobufIx  s
         bufSig = sliceBuf s :: Sig (Maybe (Array (Finite n) e))
     isIdle <- fsmSig === sig Idle
     isBusy <- fsmSig === sig Busy
@@ -138,8 +128,8 @@ instance (KnownNat n, Encode e, Width e) => Encode (Cobuf n e) where
 sliceFsm :: KnownNat n => Width e => Sig (Cobuf n e) -> Sig Fsm
 sliceFsm s = slice (width s - 1) (width s - 1) s
 
-sliceIx :: forall n e. KnownNat n => Width e => Sig (Cobuf n e) -> Sig (Finite n)
-sliceIx s = slice (width s - 2) (width (undefined :: Maybe (Array (Finite n) e))) s
+sliceCobufIx :: forall n e. KnownNat n => Width e => Sig (Cobuf n e) -> Sig (Finite n)
+sliceCobufIx s = slice (width s - 2) (width (undefined :: Maybe (Array (Finite n) e))) s
 
 sliceBuf
   :: forall n e