Merge pull request #3106 from clash-lang/eager-collection

`pack` for `Vec` and `RTree`: more defined bits

Author: christiaanb

changelog/2025-11-26T12_26_35+01_00_eager_collection

@@ -0,0 +1 @@
+FIXED: In Clash simulation, `pack` for `Vec` and `RTree` had all bits undefined when the spine of the value had an `XException`. Now, those elements with defined bits will output those defined bits. In HDL, this was already the case. Example: consider `xs = 1 :> undefined :> Nil :: Vec 2 (Unsigned 4)` and `ys = 1 :> undefined :: Vec 2 (Unsigned 4). `xs` merely has an undefined element, but `ys` has an undefined spine: it is a `:>` constructor that is undefined. `pack ys` used to be `0b...._....` but is now `0b0001_....`, just as `pack xs` already was.

changelog/2025-12-23T14_43_38+01_00_fix_3109

@@ -0,0 +1 @@
+FIXED: Clash drops cached normalization result [#3109](https://github.com/clash-lang/clash-compiler/issues/3109)

clash-lib/src/Clash/Normalize.hs

@@ -18,7 +18,7 @@ module Clash.Normalize where
 
 import           Control.Exception                (throw)
 import qualified Control.Lens                     as Lens
-import           Control.Monad                    (when)
+import           Control.Monad                    ((>=>), when)
 import           Control.Monad.State.Strict       (State)
 import           Data.Default                     (def)
 import           Data.Either                      (lefts,partitionEithers)
@@ -143,11 +143,24 @@ runNormalization env supply globals typeTrans peEval eval rcsMap topEnts =
 normalize
   :: [Id]
   -> NormalizeSession BindingMap
-normalize []  = return emptyVarEnv
-normalize top = do
-  (new,topNormalized) <- unzip <$> mapM normalize' top
-  newNormalized <- normalize (concat new)
-  return (unionVarEnv (mkVarEnv topNormalized) newNormalized)
+normalize = go >=> unionWithCache
+ where
+  go []  = return emptyVarEnv
+  go top = do
+    (new,topNormalized) <- unzip <$> mapM normalize' top
+    newNormalized <- normalize (concat new)
+    return (unionVarEnv (mkVarEnv topNormalized) newNormalized)
+
+  unionWithCache :: BindingMap -> NormalizeSession BindingMap
+  unionWithCache env = do
+    cache <- Lens.use (extra.normalized)
+    -- We need to include the cache in our final result, forgetting to do so
+    -- leads to https://github.com/clash-lang/clash-compiler/issues/3109
+    --
+    -- On the other hand, just returning the cache as our final result could
+    -- not be enough, because normalize' might return a non-normalized binder
+    -- that is later picked up and cleaned up by flattenCallTree.
+    return (unionVarEnv cache env)
 
 normalize' :: Id -> NormalizeSession ([Id], (Id, Binding Term))
 normalize' nm = do

clash-prelude/src/Clash/Sized/RTree.hs

@@ -76,7 +76,7 @@ import Prelude                     hiding ((++), (!!), map)
 import Test.QuickCheck             (Arbitrary (..), CoArbitrary (..))
 
 import Clash.Annotations.Primitive (hasBlackBox)
-import Clash.Class.BitPack         (BitPack (..), packXWith)
+import Clash.Class.BitPack         (BitPack (..))
 import Clash.Promoted.Nat          (SNat (..), UNat (..),
                                     pow2SNat, snatToNum, subSNat, toUNat)
 import Clash.Promoted.Nat.Literals (d1)
@@ -212,7 +212,7 @@ instance KnownNat d => Traversable (RTree d) where
 instance (KnownNat d, BitPack a) =>
   BitPack (RTree d a) where
   type BitSize (RTree d a) = (2^d) * (BitSize a)
-  pack   = packXWith (pack . t2v)
+  pack   = pack . t2v . lazyT
   unpack = v2t . unpack
 
 type instance Lens.Index   (RTree d a) = Int

clash-prelude/src/Clash/Sized/Vector.hs

@@ -147,7 +147,7 @@ import Clash.Promoted.Nat.Literals (d1)
 import Clash.Sized.Internal.BitVector (Bit, BitVector (..), split#)
 import Clash.Sized.Index          (Index)
 
-import Clash.Class.BitPack        (packXWith, BitPack (..))
+import Clash.Class.BitPack        (BitPack (..))
 import Clash.XException           (ShowX (..), NFDataX (..), seqX, isX)
 
 {- $setup
@@ -2630,7 +2630,7 @@ smapWithBounds f xs = reverse
 
 instance (KnownNat n, BitPack a) => BitPack (Vec n a) where
   type BitSize (Vec n a) = n * (BitSize a)
-  pack   = packXWith (concatBitVector# . map pack)
+  pack   = concatBitVector# . map pack . lazyV
   unpack = map unpack . unconcatBitVector#
 
 concatBitVector#

clash-prelude/tests/Clash/Tests/BitPack.hs

@@ -9,8 +9,11 @@ import Test.Tasty
 import Test.Tasty.HUnit
 
 import Clash.Class.BitPack
-import Clash.Sized.Vector
+import Clash.Sized.RTree
 import Clash.Sized.Signed
+import Clash.Sized.Unsigned
+import Clash.Sized.Vector
+import Clash.XException
 
 import GHC.Generics (Generic)
 
@@ -26,6 +29,24 @@ data Rec2    = Rec2 { b :: Int, c :: Int } deriving (Generic, BitPack, Eq, Show)
 rtt :: (Eq a, Show a, BitPack a) => a -> Assertion
 rtt u = unpack (pack u) @?= u
 
+{-
+@pack@ will still output defined elements even if the spine is not fully defined.
+-}
+undefSpineVec :: Assertion
+undefSpineVec = showX (pack v) @?= "0b0001_...._...."
+ where
+  v :: Vec 3 (Unsigned 4)
+  v = 1 :> Clash.XException.undefined
+
+{-
+@pack@ will still output defined elements even if the spine is not fully defined.
+-}
+undefSpineRTree :: Assertion
+undefSpineRTree = showX (pack t) @?= "0b...._...._0101_...."
+ where
+  t :: RTree 2 (Unsigned 4)
+  t = BR Clash.XException.undefined (BR (LR 5) Clash.XException.undefined)
+
 tests :: TestTree
 tests =
   testGroup
@@ -46,7 +67,8 @@ tests =
         , testCase "SP2" (rtt (P 10))
         , testCase "Rec1" (rtt (Rec1 10))
         , testCase "Rec2" (rtt (Rec2 10 30))
-        , testCase "Vec" (rtt ((1 :: Signed 6) :> 2 :> (-5) :> 4 :> Nil))
         ]
+    , testCase "Vec" (rtt ((1 :: Signed 6) :> 2 :> (-5) :> 4 :> Nil))
+    , testCase "undefSpineVec" undefSpineVec
+    , testCase "undefSpineRTree" undefSpineRTree
     ]
-