{-# LANGUAGE BlockArguments   #-}
{-# LANGUAGE TypeApplications #-}
module Data.Snowchecked.Internal.Import
	( module Data.Snowchecked.Internal.Import
	, module Data.Snowchecked.Types
	, module Data.Bits
	, module Data.WideWord.Word256
	, module Data.Word
	, module Numeric
	) where

import           Data.Bits              (Bits, shiftL, shiftR, (.&.), (.|.))
import           Data.Snowchecked.Types
import           Data.WideWord.Word256
import           Data.Word
import           Numeric

cutBits :: (Num a, Bits a, Integral bitCount) => a -> bitCount -> a
cutBits :: a -> bitCount -> a
cutBits a
n bitCount
bits = a
n a -> a -> a
forall a. Bits a => a -> a -> a
.&. ((a
1 a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` bitCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral bitCount
bits) a -> a -> a
forall a. Num a => a -> a -> a
- a
1)
{-# INLINE cutBits #-}

cutShiftBits :: (Num a, Bits a, Integral cutBitCount, Integral shiftBitCount) => a -> cutBitCount -> shiftBitCount -> a
cutShiftBits :: a -> cutBitCount -> shiftBitCount -> a
cutShiftBits a
n cutBitCount
cutBitCount shiftBitCount
shiftBitCount = a -> cutBitCount -> a
forall a bitCount.
(Num a, Bits a, Integral bitCount) =>
a -> bitCount -> a
cutBits a
n cutBitCount
cutBitCount a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` shiftBitCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral shiftBitCount
shiftBitCount
{-# INLINE cutShiftBits #-}

shiftCutBits :: (Num a, Bits a, Integral cutBitCount, Integral shiftBitCount) => a -> shiftBitCount -> cutBitCount -> a
shiftCutBits :: a -> shiftBitCount -> cutBitCount -> a
shiftCutBits a
n shiftBitCount
shiftBitCount = a -> cutBitCount -> a
forall a bitCount.
(Num a, Bits a, Integral bitCount) =>
a -> bitCount -> a
cutBits (a -> cutBitCount -> a) -> a -> cutBitCount -> a
forall a b. (a -> b) -> a -> b
$ a
n a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` shiftBitCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral shiftBitCount
shiftBitCount
{-# INLINE shiftCutBits #-}

toInt :: (Integral a) => a -> Int
toInt :: a -> Int
toInt = (Integral a, Num Int) => a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral @_ @Int
{-# INLINE toInt #-}

toWord8 :: (Integral a) => a -> Word8
toWord8 :: a -> Word8
toWord8 = (Integral a, Num Word8) => a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral @_ @Word8
{-# INLINE toWord8 #-}

toWord32 :: (Integral a) => a -> Word32
toWord32 :: a -> Word32
toWord32 = (Integral a, Num Word32) => a -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral @_ @Word32
{-# INLINE toWord32 #-}