-- Extra bits stuff
module Foundation.Bits
    ( (.<<.)
    , (.>>.)
    , Bits(..)
    , alignRoundUp
    , alignRoundDown
    ) where

import Basement.Compat.Base
import Foundation.Numerical
import Data.Bits hiding ((.<<.), (.>>.))

-- | Unsafe Shift Left Operator
(.<<.) :: Bits a => a -> Int -> a
.<<. :: a -> Int -> a
(.<<.) = a -> Int -> a
forall a. Bits a => a -> Int -> a
unsafeShiftL

-- | Unsafe Shift Right Operator
(.>>.) :: Bits a => a -> Int -> a
.>>. :: a -> Int -> a
(.>>.) = a -> Int -> a
forall a. Bits a => a -> Int -> a
unsafeShiftR

-- | Round up (if needed) to a multiple of @alignment@ closst to @m@
--
-- @alignment@ needs to be a power of two
--
-- alignRoundUp 16 8 = 16
-- alignRoundUp 15 8 = 16
alignRoundUp :: Int -- ^ Number to Align
             -> Int -- ^ Alignment (power of 2)
             -> Int
alignRoundUp :: Int -> Int -> Int
alignRoundUp Int
m Int
alignment = (Int
m Int -> Int -> Int
forall a. Additive a => a -> a -> a
+ (Int
alignmentInt -> Int -> Difference Int
forall a. Subtractive a => a -> a -> Difference a
-Int
1)) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int -> Int
forall a. Bits a => a -> a
complement (Int
alignmentInt -> Int -> Difference Int
forall a. Subtractive a => a -> a -> Difference a
-Int
1)

-- | Round down (if needed) to a multiple of @alignment@ closest to @m@
--
-- @alignment@ needs to be a power of two
--
-- > alignRoundDown 15 8 = 8
-- > alignRoundDown 8 8  = 8
alignRoundDown :: Int -- ^ Number to Align
               -> Int -- ^ Alignment (power of 2)
               -> Int
alignRoundDown :: Int -> Int -> Int
alignRoundDown Int
m Int
alignment = Int
m Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int -> Int
forall a. Bits a => a -> a
complement (Int
alignmentInt -> Int -> Difference Int
forall a. Subtractive a => a -> a -> Difference a
-Int
1)