Add (<<%) and (%>>)

Author: kleinreact

clash-prelude/clash-prelude.cabal

@@ -178,6 +178,7 @@ Library
                       Clash.Class.BitPack
                       Clash.Class.BitPack.BitIndex
                       Clash.Class.BitPack.BitReduction
+                      Clash.Class.BitPack.BitShift
                       Clash.Class.BitPack.Internal
                       Clash.Class.BitPack.Internal.TH
                       Clash.Class.Counter

clash-prelude/src/Clash/Class/BitPack.hs

@@ -2,7 +2,7 @@
 {-|
 Copyright  :  (C) 2013-2016, University of Twente
                   2016-2017, Myrtle Software Ltd
-                       2021, QBayLogic B.V.
+                  2021-2025, QBayLogic B.V.
 License    :  BSD2 (see the file LICENSE)
 Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>
 -}
@@ -33,9 +33,14 @@ module Clash.Class.BitPack
   , reduceAnd
   , reduceOr
   , reduceXor
+
+  -- * Bit Shifts
+  , (<<%)
+  , (%>>)
   )
 where
 
 import Clash.Class.BitPack.Internal
 import Clash.Class.BitPack.BitIndex
 import Clash.Class.BitPack.BitReduction
+import Clash.Class.BitPack.BitShift

clash-prelude/src/Clash/Class/BitPack/BitShift.hs

@@ -0,0 +1,50 @@
+{-|
+Copyright  :  (C) 2025, QBayLogic B.V.
+License    :  BSD2 (see the file LICENSE)
+Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>
+-}
+
+{-# LANGUAGE Safe #-}
+
+{-# OPTIONS_GHC -fplugin GHC.TypeLits.Normalise #-}
+
+module Clash.Class.BitPack.BitShift where
+
+import Clash.Class.BitPack.Internal (BitPack (..), bitCoerce)
+import Clash.Promoted.Nat           (SNat (..))
+import Clash.Sized.BitVector        (BitVector)
+
+{- $setup
+>>> import Clash.Prelude
+-}
+
+{-# INLINE (<<%) #-}
+-- | Left shift the bits by the given amount.
+--
+-- >>> (1 :: Unsigned 3) <<% d0
+-- 1
+-- >>> (1 :: Unsigned 3) <<% d2
+-- 4
+-- >>> (1 :: Unsigned 3) <<% d4
+-- 0
+-- >>> pack (-1 :: Signed 6)
+-- 0b11_1111
+-- >>> reduceAnd (-1 :: Signed 6)
+infixl 7 <<%
+(<<%) :: forall a n. BitPack a => a -> SNat n -> a
+x <<% SNat =
+  unpack $ snd @(BitVector n) @_ $ bitCoerce (pack x, 0 :: BitVector n)
+
+{-# INLINE (%>>) #-}
+-- | Right shift the bits by the given amount.
+--
+-- >>> d0 %>> (4 :: Unsigned 3)
+-- 4
+-- >>> d1 %>> (4 :: Unsigned 3)
+-- 2
+-- >>> d5 %>> (4 :: Unsigned 3)
+-- 0
+infixl 7 %>>
+(%>>) :: forall a n. BitPack a => SNat n -> a -> a
+SNat %>> x  =
+  unpack $ fst @_ @(BitVector n) $ bitCoerce (0 :: BitVector n, pack x)