{-# 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) => a -> Int -> a
cutBits :: forall a. (Num a, Bits a) => a -> Int -> a
cutBits a
n Int
bits = a
n forall a. Bits a => a -> a -> a
.&. ((a
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
bits) forall a. Num a => a -> a -> a
- a
1)
{-# INLINE cutBits #-}

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

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

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

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

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