Fix BitVector shifts (#2732)

(cherry picked from commit f96795e)

Co-authored-by: Felix Klein <[email protected]>

changelog/2024-05-31T20_14_29+02_00_fix_bitvector_shifts

@@ -0,0 +1 @@
+FIXED: (+>>.) and (.<<+) such that they are compliant with (+>>) and (<<+) for vectors of zero length in the sense that the input vector is kept unchanged.

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

@@ -1,11 +1,12 @@
 {-|
 Copyright  :  (C) 2013-2016, University of Twente
-                  2022     , Google Inc.
+                  2022-2024, Google Inc.
 License    :  BSD2 (see the file LICENSE)
 Maintainer :  Christiaan Baaij <[email protected]>
 -}
 
 {-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE TypeFamilies #-}
 
 {-# OPTIONS_HADDOCK show-extensions #-}
 
@@ -37,7 +38,7 @@ module Clash.Sized.BitVector
 where
 
 import Clash.Sized.Internal.BitVector
-import Clash.Promoted.Nat (natToNum)
+import Clash.Promoted.Nat (SNat(..), SNatLE(..), compareSNat, natToNum)
 import Data.Bits (shiftL, shiftR)
 import GHC.TypeNats (KnownNat)
 
@@ -55,7 +56,9 @@ infixr 4 +>>.
 -- 0b0111_1000
 --
 (+>>.) :: forall n. KnownNat n => Bit -> BitVector n -> BitVector n
-b +>>. bv = replaceBit# (shiftR bv 1) (natToNum @n - 1) b
+b +>>. bv = case compareSNat (SNat @n) (SNat @0) of
+  SNatGT -> replaceBit# (shiftR bv 1) (natToNum @n - 1) b
+  SNatLE -> bv
 
 infixr 4 .<<+
 -- | Shift in a bit from the LSB side of a 'BitVector'. Equal to left shifting
@@ -67,4 +70,6 @@ infixr 4 .<<+
 -- 0b1110_0001
 --
 (.<<+) :: forall n. KnownNat n => BitVector n -> Bit -> BitVector n
-bv .<<+ b = replaceBit# (shiftL bv 1) 0 b
+bv .<<+ b = case compareSNat (SNat @n) (SNat @0) of
+  SNatGT -> replaceBit# (shiftL bv 1) 0 b
+  SNatLE -> bv