From 6efdf62da0fae24deac1317bf1ce5658519eeb74 Mon Sep 17 00:00:00 2001 From: "mergify[bot]" <37929162+mergify[bot]@users.noreply.github.com> Date: Sun, 2 Jun 2024 12:41:06 +0200 Subject: [PATCH] Fix BitVector shifts (#2732) (cherry picked from commit f96795e971ec3aa5ed18b78543752b5c7ed06dad) Co-authored-by: Felix Klein --- .../2024-05-31T20_14_29+02_00_fix_bitvector_shifts | 1 + clash-prelude/src/Clash/Sized/BitVector.hs | 13 +++++++++---- 2 files changed, 10 insertions(+), 4 deletions(-) create mode 100644 changelog/2024-05-31T20_14_29+02_00_fix_bitvector_shifts diff --git a/changelog/2024-05-31T20_14_29+02_00_fix_bitvector_shifts b/changelog/2024-05-31T20_14_29+02_00_fix_bitvector_shifts new file mode 100644 index 0000000000..fdbbee4b18 --- /dev/null +++ b/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. diff --git a/clash-prelude/src/Clash/Sized/BitVector.hs b/clash-prelude/src/Clash/Sized/BitVector.hs index 801072a72b..b6266c0af0 100644 --- a/clash-prelude/src/Clash/Sized/BitVector.hs +++ b/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 -} {-# 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