{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Data.SizedInt
    ( SizedInt ) where

import Data.Bits
          (Bits, shiftL, shiftR, rotateL, rotateR, bit, testBit, popCount,
           complement, xor, bitSize, isSigned, (.&.), (.|.), )

import qualified Type.Data.Num as Num
import Type.Base.Proxy (Proxy(Proxy))


newtype SizedInt nT = SizedInt Integer

_sizeT :: SizedInt nT -> Proxy nT
_sizeT :: SizedInt nT -> Proxy nT
_sizeT SizedInt nT
_ = Proxy nT
forall a. Proxy a
Proxy

mask :: forall nT . Num.Natural nT => Proxy nT -> Integer
mask :: Proxy nT -> Integer
mask Proxy nT
n = Int -> Integer
forall a. Bits a => Int -> a
bit (Proxy nT -> Int
forall x y. (Integer x, Num y) => Proxy x -> y
Num.fromInteger Proxy nT
n) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1

signBit :: forall nT . Num.Natural nT => Proxy nT -> Int
signBit :: Proxy nT -> Int
signBit Proxy nT
n = Proxy nT -> Int
forall x y. (Integer x, Num y) => Proxy x -> y
Num.fromInteger Proxy nT
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

isNegative :: forall nT . Num.Natural nT
           => SizedInt nT
           -> Bool
isNegative :: SizedInt nT -> Bool
isNegative (SizedInt Integer
x) =
    Integer -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Integer
x (Int -> Bool) -> Int -> Bool
forall a b. (a -> b) -> a -> b
$ Proxy nT -> Int
forall nT. Natural nT => Proxy nT -> Int
signBit (Proxy nT
forall a. Proxy a
Proxy :: Proxy nT)

instance Num.Natural nT => Eq (SizedInt nT) where
    (SizedInt Integer
x) == :: SizedInt nT -> SizedInt nT -> Bool
== (SizedInt Integer
y) = Integer
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
y
    (SizedInt Integer
x) /= :: SizedInt nT -> SizedInt nT -> Bool
/= (SizedInt Integer
y) = Integer
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
y

instance Num.Natural nT => Show (SizedInt nT) where
    showsPrec :: Int -> SizedInt nT -> ShowS
showsPrec Int
prec SizedInt nT
n =
        Int -> Integer -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
prec (Integer -> ShowS) -> Integer -> ShowS
forall a b. (a -> b) -> a -> b
$ SizedInt nT -> Integer
forall a. Integral a => a -> Integer
toInteger SizedInt nT
n

instance Num.Natural nT => Read (SizedInt nT) where
    readsPrec :: Int -> ReadS (SizedInt nT)
readsPrec Int
prec String
str0 =
        [ (Integer -> SizedInt nT
forall a. Num a => Integer -> a
fromInteger Integer
n, String
str)
        | (Integer
n, String
str) <- Int -> ReadS Integer
forall a. Read a => Int -> ReadS a
readsPrec Int
prec String
str0 ]

instance Num.Natural nT => Ord (SizedInt nT) where
    SizedInt nT
a compare :: SizedInt nT -> SizedInt nT -> Ordering
`compare` SizedInt nT
b = SizedInt nT -> Integer
forall a. Integral a => a -> Integer
toInteger SizedInt nT
a Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` SizedInt nT -> Integer
forall a. Integral a => a -> Integer
toInteger SizedInt nT
b

instance Num.Natural nT => Bounded (SizedInt nT) where
    minBound :: SizedInt nT
minBound = Integer -> SizedInt nT
forall nT. Integer -> SizedInt nT
SizedInt (Integer -> SizedInt nT) -> Integer -> SizedInt nT
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Num a => a -> a
negate (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Integer
1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` (Proxy nT -> Int
forall x y. (Integer x, Num y) => Proxy x -> y
Num.fromInteger (Proxy nT
forall a. Proxy a
Proxy :: Proxy nT) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    maxBound :: SizedInt nT
maxBound = Integer -> SizedInt nT
forall nT. Integer -> SizedInt nT
SizedInt (Integer -> SizedInt nT) -> Integer -> SizedInt nT
forall a b. (a -> b) -> a -> b
$ (Integer
1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` (Proxy nT -> Int
forall x y. (Integer x, Num y) => Proxy x -> y
Num.fromInteger (Proxy nT
forall a. Proxy a
Proxy :: Proxy nT) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1

instance Num.Natural nT => Enum (SizedInt nT) where
    succ :: SizedInt nT -> SizedInt nT
succ SizedInt nT
x
       | SizedInt nT
x SizedInt nT -> SizedInt nT -> Bool
forall a. Eq a => a -> a -> Bool
== SizedInt nT
forall a. Bounded a => a
maxBound  = String -> SizedInt nT
forall a. HasCallStack => String -> a
error (String -> SizedInt nT) -> String -> SizedInt nT
forall a b. (a -> b) -> a -> b
$ String
"Enum.succ{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ SizedInt nT -> String
forall nT. Natural nT => SizedInt nT -> String
showSizedIntType SizedInt nT
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}: tried to take `succ' of maxBound"
       | Bool
otherwise      = SizedInt nT
x SizedInt nT -> SizedInt nT -> SizedInt nT
forall a. Num a => a -> a -> a
+ SizedInt nT
1
    pred :: SizedInt nT -> SizedInt nT
pred SizedInt nT
x
       | SizedInt nT
x SizedInt nT -> SizedInt nT -> Bool
forall a. Eq a => a -> a -> Bool
== SizedInt nT
forall a. Bounded a => a
minBound  = String -> SizedInt nT
forall a. HasCallStack => String -> a
error (String -> SizedInt nT) -> String -> SizedInt nT
forall a b. (a -> b) -> a -> b
$ String
"Enum.succ{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ SizedInt nT -> String
forall nT. Natural nT => SizedInt nT -> String
showSizedIntType SizedInt nT
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}: tried to take `pred' of minBound"
       | Bool
otherwise      = SizedInt nT
x SizedInt nT -> SizedInt nT -> SizedInt nT
forall a. Num a => a -> a -> a
- SizedInt nT
1
    
    fromEnum :: SizedInt nT -> Int
fromEnum s :: SizedInt nT
s@(SizedInt Integer
x)
        | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int
forall a. Bounded a => a
maxBound :: Int) =
            String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
"Enum.fromEnum{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ SizedInt nT -> String
forall nT. Natural nT => SizedInt nT -> String
showSizedIntType SizedInt nT
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}: tried to take `fromEnum' on SizedInt greater than maxBound :: Int"
        | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int
forall a. Bounded a => a
minBound :: Int) =
            String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
"Enum.fromEnum{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ SizedInt nT -> String
forall nT. Natural nT => SizedInt nT -> String
showSizedIntType SizedInt nT
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}: tried to take `fromEnum' on SizedInt smaller than minBound :: Int"
        | Bool
otherwise =
            Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
x
    toEnum :: Int -> SizedInt nT
toEnum Int
x
        | Integer
x' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> SizedInt nT -> Integer
forall a. Integral a => a -> Integer
toInteger (SizedInt nT
forall a. Bounded a => a
maxBound :: SizedInt nT) =
            String -> SizedInt nT
forall a. HasCallStack => String -> a
error (String -> SizedInt nT) -> String -> SizedInt nT
forall a b. (a -> b) -> a -> b
$ String
"Enum.fromEnum{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Proxy nT -> String
forall nT. Natural nT => Proxy nT -> String
showSizedIntTypeProxy Proxy nT
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}: tried to take `fromEnum' on SizedInt greater than maxBound :: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Proxy nT -> String
forall nT. Natural nT => Proxy nT -> String
showSizedIntTypeProxy Proxy nT
n
        | Integer
x' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< SizedInt nT -> Integer
forall a. Integral a => a -> Integer
toInteger (SizedInt nT
forall a. Bounded a => a
minBound :: SizedInt nT) =
            String -> SizedInt nT
forall a. HasCallStack => String -> a
error (String -> SizedInt nT) -> String -> SizedInt nT
forall a b. (a -> b) -> a -> b
$ String
"Enum.fromEnum{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Proxy nT -> String
forall nT. Natural nT => Proxy nT -> String
showSizedIntTypeProxy Proxy nT
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}: tried to take `fromEnum' on SizedInt smaller than minBound :: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Proxy nT -> String
forall nT. Natural nT => Proxy nT -> String
showSizedIntTypeProxy Proxy nT
n
        | Bool
otherwise =
            Integer -> SizedInt nT
forall a. Num a => Integer -> a
fromInteger Integer
x'
            where x' :: Integer
x' = Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
x
                  n :: Proxy nT
n = Proxy nT
forall a. Proxy a
Proxy :: Proxy nT

instance Num.Natural nT => Num (SizedInt nT) where
    (SizedInt Integer
a) + :: SizedInt nT -> SizedInt nT -> SizedInt nT
+ (SizedInt Integer
b) =
        Integer -> SizedInt nT
forall a. Num a => Integer -> a
fromInteger (Integer -> SizedInt nT) -> Integer -> SizedInt nT
forall a b. (a -> b) -> a -> b
$ Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
b
    (SizedInt Integer
a) * :: SizedInt nT -> SizedInt nT -> SizedInt nT
* (SizedInt Integer
b) =
        Integer -> SizedInt nT
forall a. Num a => Integer -> a
fromInteger (Integer -> SizedInt nT) -> Integer -> SizedInt nT
forall a b. (a -> b) -> a -> b
$ Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
b
    negate :: SizedInt nT -> SizedInt nT
negate (SizedInt Integer
n) =
        Integer -> SizedInt nT
forall a. Num a => Integer -> a
fromInteger (Integer -> SizedInt nT) -> Integer -> SizedInt nT
forall a b. (a -> b) -> a -> b
$ (Integer
n Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
`xor` Proxy nT -> Integer
forall nT. Natural nT => Proxy nT -> Integer
mask (Proxy nT
forall a. Proxy a
Proxy :: Proxy nT)) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1
    SizedInt nT
a - :: SizedInt nT -> SizedInt nT -> SizedInt nT
- SizedInt nT
b =
        SizedInt nT
a SizedInt nT -> SizedInt nT -> SizedInt nT
forall a. Num a => a -> a -> a
+ (SizedInt nT -> SizedInt nT
forall a. Num a => a -> a
negate SizedInt nT
b)

    fromInteger :: Integer -> SizedInt nT
fromInteger Integer
n =
      let fromCardinal :: Integer -> SizedInt nT
fromCardinal Integer
m = Integer -> SizedInt nT
forall nT. Integer -> SizedInt nT
SizedInt (Integer -> SizedInt nT) -> Integer -> SizedInt nT
forall a b. (a -> b) -> a -> b
$ Integer
m Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Proxy nT -> Integer
forall nT. Natural nT => Proxy nT -> Integer
mask (Proxy nT
forall a. Proxy a
Proxy :: Proxy nT)
      in  if Integer
nInteger -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>=Integer
0
            then Integer -> SizedInt nT
fromCardinal Integer
n
            else SizedInt nT -> SizedInt nT
forall a. Num a => a -> a
negate (SizedInt nT -> SizedInt nT) -> SizedInt nT -> SizedInt nT
forall a b. (a -> b) -> a -> b
$ Integer -> SizedInt nT
fromCardinal (Integer -> SizedInt nT) -> Integer -> SizedInt nT
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Num a => a -> a
negate Integer
n

    abs :: SizedInt nT -> SizedInt nT
abs SizedInt nT
s
      | SizedInt nT -> Bool
forall nT. Natural nT => SizedInt nT -> Bool
isNegative SizedInt nT
s =
          SizedInt nT -> SizedInt nT
forall a. Num a => a -> a
negate SizedInt nT
s
      | Bool
otherwise =
          SizedInt nT
s
    signum :: SizedInt nT -> SizedInt nT
signum SizedInt nT
s
      | SizedInt nT -> Bool
forall nT. Natural nT => SizedInt nT -> Bool
isNegative SizedInt nT
s =
          -SizedInt nT
1
      | SizedInt nT
s SizedInt nT -> SizedInt nT -> Bool
forall a. Eq a => a -> a -> Bool
== SizedInt nT
0 =
          SizedInt nT
0
      | Bool
otherwise =
          SizedInt nT
1

instance Num.Natural nT => Real (SizedInt nT) where
    toRational :: SizedInt nT -> Rational
toRational SizedInt nT
n = Integer -> Rational
forall a. Real a => a -> Rational
toRational (Integer -> Rational) -> Integer -> Rational
forall a b. (a -> b) -> a -> b
$ SizedInt nT -> Integer
forall a. Integral a => a -> Integer
toInteger SizedInt nT
n

instance Num.Natural nT => Integral (SizedInt nT) where
    SizedInt nT
a quot :: SizedInt nT -> SizedInt nT -> SizedInt nT
`quot` SizedInt nT
b =
        Integer -> SizedInt nT
forall a. Num a => Integer -> a
fromInteger (Integer -> SizedInt nT) -> Integer -> SizedInt nT
forall a b. (a -> b) -> a -> b
$ SizedInt nT -> Integer
forall a. Integral a => a -> Integer
toInteger SizedInt nT
a Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` SizedInt nT -> Integer
forall a. Integral a => a -> Integer
toInteger SizedInt nT
b
    SizedInt nT
a rem :: SizedInt nT -> SizedInt nT -> SizedInt nT
`rem` SizedInt nT
b =
        Integer -> SizedInt nT
forall a. Num a => Integer -> a
fromInteger (Integer -> SizedInt nT) -> Integer -> SizedInt nT
forall a b. (a -> b) -> a -> b
$ SizedInt nT -> Integer
forall a. Integral a => a -> Integer
toInteger SizedInt nT
a Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`rem` SizedInt nT -> Integer
forall a. Integral a => a -> Integer
toInteger SizedInt nT
b
    SizedInt nT
a div :: SizedInt nT -> SizedInt nT -> SizedInt nT
`div` SizedInt nT
b =
        Integer -> SizedInt nT
forall a. Num a => Integer -> a
fromInteger (Integer -> SizedInt nT) -> Integer -> SizedInt nT
forall a b. (a -> b) -> a -> b
$ SizedInt nT -> Integer
forall a. Integral a => a -> Integer
toInteger SizedInt nT
a Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` SizedInt nT -> Integer
forall a. Integral a => a -> Integer
toInteger SizedInt nT
b
    SizedInt nT
a mod :: SizedInt nT -> SizedInt nT -> SizedInt nT
`mod` SizedInt nT
b =
        Integer -> SizedInt nT
forall a. Num a => Integer -> a
fromInteger (Integer -> SizedInt nT) -> Integer -> SizedInt nT
forall a b. (a -> b) -> a -> b
$ SizedInt nT -> Integer
forall a. Integral a => a -> Integer
toInteger SizedInt nT
a Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` SizedInt nT -> Integer
forall a. Integral a => a -> Integer
toInteger SizedInt nT
b
    SizedInt nT
a quotRem :: SizedInt nT -> SizedInt nT -> (SizedInt nT, SizedInt nT)
`quotRem` SizedInt nT
b =
        let (Integer
quot_, Integer
rem_) = SizedInt nT -> Integer
forall a. Integral a => a -> Integer
toInteger SizedInt nT
a Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`quotRem` SizedInt nT -> Integer
forall a. Integral a => a -> Integer
toInteger SizedInt nT
b
        in (Integer -> SizedInt nT
forall a. Num a => Integer -> a
fromInteger Integer
quot_, Integer -> SizedInt nT
forall a. Num a => Integer -> a
fromInteger Integer
rem_)
    SizedInt nT
a divMod :: SizedInt nT -> SizedInt nT -> (SizedInt nT, SizedInt nT)
`divMod` SizedInt nT
b =
        let (Integer
div_, Integer
mod_) = SizedInt nT -> Integer
forall a. Integral a => a -> Integer
toInteger SizedInt nT
a Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`divMod` SizedInt nT -> Integer
forall a. Integral a => a -> Integer
toInteger SizedInt nT
b
        in (Integer -> SizedInt nT
forall a. Num a => Integer -> a
fromInteger Integer
div_, Integer -> SizedInt nT
forall a. Num a => Integer -> a
fromInteger Integer
mod_)
    toInteger :: SizedInt nT -> Integer
toInteger s :: SizedInt nT
s@(SizedInt Integer
x) =
        if SizedInt nT -> Bool
forall nT. Natural nT => SizedInt nT -> Bool
isNegative SizedInt nT
s
           then let SizedInt Integer
x' = SizedInt nT -> SizedInt nT
forall a. Num a => a -> a
negate SizedInt nT
s in Integer -> Integer
forall a. Num a => a -> a
negate Integer
x'
           else Integer
x

instance Num.Natural nT => Bits (SizedInt nT) where
    (SizedInt Integer
a) .&. :: SizedInt nT -> SizedInt nT -> SizedInt nT
.&. (SizedInt Integer
b) = Integer -> SizedInt nT
forall nT. Integer -> SizedInt nT
SizedInt (Integer -> SizedInt nT) -> Integer -> SizedInt nT
forall a b. (a -> b) -> a -> b
$ Integer
a Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
b
    (SizedInt Integer
a) .|. :: SizedInt nT -> SizedInt nT -> SizedInt nT
.|. (SizedInt Integer
b) = Integer -> SizedInt nT
forall nT. Integer -> SizedInt nT
SizedInt (Integer -> SizedInt nT) -> Integer -> SizedInt nT
forall a b. (a -> b) -> a -> b
$ Integer
a Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
b
    (SizedInt Integer
a) xor :: SizedInt nT -> SizedInt nT -> SizedInt nT
`xor` SizedInt Integer
b = Integer -> SizedInt nT
forall nT. Integer -> SizedInt nT
SizedInt (Integer -> SizedInt nT) -> Integer -> SizedInt nT
forall a b. (a -> b) -> a -> b
$ Integer
a Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
`xor` Integer
b
    complement :: SizedInt nT -> SizedInt nT
complement (SizedInt Integer
x) = Integer -> SizedInt nT
forall nT. Integer -> SizedInt nT
SizedInt (Integer -> SizedInt nT) -> Integer -> SizedInt nT
forall a b. (a -> b) -> a -> b
$ Integer
x Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
`xor` Proxy nT -> Integer
forall nT. Natural nT => Proxy nT -> Integer
mask (Proxy nT
forall a. Proxy a
Proxy :: Proxy nT)
    bit :: Int -> SizedInt nT
bit Int
b =
      case Integer -> SizedInt nT
forall nT. Integer -> SizedInt nT
SizedInt (Integer -> SizedInt nT) -> Integer -> SizedInt nT
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a. Bits a => Int -> a
bit Int
b of
        SizedInt nT
s | Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> String -> SizedInt nT
forall a. HasCallStack => String -> a
error (String -> SizedInt nT) -> String -> SizedInt nT
forall a b. (a -> b) -> a -> b
$ String
"Bits.bit{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ SizedInt nT -> String
forall nT. Natural nT => SizedInt nT -> String
showSizedIntType SizedInt nT
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}: tried to set negative position"
          | Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= SizedInt nT -> Int
forall a. Bits a => a -> Int
bitSize SizedInt nT
s -> String -> SizedInt nT
forall a. HasCallStack => String -> a
error (String -> SizedInt nT) -> String -> SizedInt nT
forall a b. (a -> b) -> a -> b
$ String
"Bits.bit{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ SizedInt nT -> String
forall nT. Natural nT => SizedInt nT -> String
showSizedIntType SizedInt nT
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}: tried to set too large position"
          | Bool
otherwise -> SizedInt nT
s
    s :: SizedInt nT
s@(SizedInt Integer
x) testBit :: SizedInt nT -> Int -> Bool
`testBit` Int
b
      | Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> Bool
forall a. HasCallStack => String -> a
error (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
"Bits.testBit{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ SizedInt nT -> String
forall nT. Natural nT => SizedInt nT -> String
showSizedIntType SizedInt nT
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}: tried to test negative position"
      | Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= SizedInt nT -> Int
forall a. Bits a => a -> Int
bitSize SizedInt nT
s = String -> Bool
forall a. HasCallStack => String -> a
error (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
"Bits.testBit{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ SizedInt nT -> String
forall nT. Natural nT => SizedInt nT -> String
showSizedIntType SizedInt nT
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}: tried to test too large position"
      | Bool
otherwise =
         Integer -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Integer
x Int
b
    s :: SizedInt nT
s@(SizedInt Integer
x) shiftL :: SizedInt nT -> Int -> SizedInt nT
`shiftL` Int
b
      | Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> SizedInt nT
forall a. HasCallStack => String -> a
error (String -> SizedInt nT) -> String -> SizedInt nT
forall a b. (a -> b) -> a -> b
$ String
"Bits.shiftL{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ SizedInt nT -> String
forall nT. Natural nT => SizedInt nT -> String
showSizedIntType SizedInt nT
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}: tried to shift by negative amount"
      | Bool
otherwise =
        Integer -> SizedInt nT
forall nT. Integer -> SizedInt nT
SizedInt (Integer -> SizedInt nT) -> Integer -> SizedInt nT
forall a b. (a -> b) -> a -> b
$ Proxy nT -> Integer
forall nT. Natural nT => Proxy nT -> Integer
mask (Proxy nT
forall a. Proxy a
Proxy :: Proxy nT) Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. (Integer
x Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
b)
    s :: SizedInt nT
s@(SizedInt Integer
x) shiftR :: SizedInt nT -> Int -> SizedInt nT
`shiftR` Int
b
      | Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> SizedInt nT
forall a. HasCallStack => String -> a
error (String -> SizedInt nT) -> String -> SizedInt nT
forall a b. (a -> b) -> a -> b
$ String
"Bits.shiftR{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ SizedInt nT -> String
forall nT. Natural nT => SizedInt nT -> String
showSizedIntType SizedInt nT
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}: tried to shift by negative amount"
      | SizedInt nT -> Bool
forall nT. Natural nT => SizedInt nT -> Bool
isNegative SizedInt nT
s =
        Integer -> SizedInt nT
forall nT. Integer -> SizedInt nT
SizedInt (Integer -> SizedInt nT) -> Integer -> SizedInt nT
forall a b. (a -> b) -> a -> b
$ Proxy nT -> Integer
forall nT. Natural nT => Proxy nT -> Integer
mask (Proxy nT
forall a. Proxy a
Proxy :: Proxy nT) Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&.
            ((Integer
x Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
b) Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. (Proxy nT -> Integer
forall nT. Natural nT => Proxy nT -> Integer
mask (Proxy nT
forall a. Proxy a
Proxy :: Proxy nT) Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` (Proxy nT -> Int
forall x y. (Integer x, Num y) => Proxy x -> y
Num.fromInteger (Proxy nT
forall a. Proxy a
Proxy :: Proxy nT) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
b)))
      | Bool
otherwise =
        Integer -> SizedInt nT
forall nT. Integer -> SizedInt nT
SizedInt (Integer -> SizedInt nT) -> Integer -> SizedInt nT
forall a b. (a -> b) -> a -> b
$ (Proxy nT -> Integer
forall nT. Natural nT => Proxy nT -> Integer
mask (Proxy nT
forall a. Proxy a
Proxy :: Proxy nT)) Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. (Integer
x Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
b)
    s :: SizedInt nT
s@(SizedInt Integer
a) rotateL :: SizedInt nT -> Int -> SizedInt nT
`rotateL` Int
b
      | Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 =
        String -> SizedInt nT
forall a. HasCallStack => String -> a
error (String -> SizedInt nT) -> String -> SizedInt nT
forall a b. (a -> b) -> a -> b
$ String
"Bits.rotateL{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ SizedInt nT -> String
forall nT. Natural nT => SizedInt nT -> String
showSizedIntType SizedInt nT
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}: tried to rotate by negative amount"
      | Bool
otherwise =
        Integer -> SizedInt nT
forall nT. Integer -> SizedInt nT
SizedInt (Integer -> SizedInt nT) -> Integer -> SizedInt nT
forall a b. (a -> b) -> a -> b
$ Proxy nT -> Integer
forall nT. Natural nT => Proxy nT -> Integer
mask (Proxy nT
forall a. Proxy a
Proxy :: Proxy nT) Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&.
            ((Integer
a Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
b) Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. (Integer
a Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` (Proxy nT -> Int
forall x y. (Integer x, Num y) => Proxy x -> y
Num.fromInteger (Proxy nT
forall a. Proxy a
Proxy :: Proxy nT) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
b)))
    s :: SizedInt nT
s@(SizedInt Integer
a) rotateR :: SizedInt nT -> Int -> SizedInt nT
`rotateR` Int
b
      | Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 =
        String -> SizedInt nT
forall a. HasCallStack => String -> a
error (String -> SizedInt nT) -> String -> SizedInt nT
forall a b. (a -> b) -> a -> b
$ String
"Bits.rotateR{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ SizedInt nT -> String
forall nT. Natural nT => SizedInt nT -> String
showSizedIntType SizedInt nT
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}: tried to rotate by negative amount"
      | Bool
otherwise =
        Integer -> SizedInt nT
forall nT. Integer -> SizedInt nT
SizedInt (Integer -> SizedInt nT) -> Integer -> SizedInt nT
forall a b. (a -> b) -> a -> b
$ Proxy nT -> Integer
forall nT. Natural nT => Proxy nT -> Integer
mask (Proxy nT
forall a. Proxy a
Proxy :: Proxy nT) Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&.
            ((Integer
a Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
b) Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. (Integer
a Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` (Proxy nT -> Int
forall x y. (Integer x, Num y) => Proxy x -> y
Num.fromInteger (Proxy nT
forall a. Proxy a
Proxy :: Proxy nT) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
b)))
    popCount :: SizedInt nT -> Int
popCount (SizedInt Integer
x) = Integer -> Int
forall a. Bits a => a -> Int
popCount Integer
x
    bitSize :: SizedInt nT -> Int
bitSize SizedInt nT
_ = Proxy nT -> Int
forall x y. (Integer x, Num y) => Proxy x -> y
Num.fromInteger (Proxy nT
forall a. Proxy a
Proxy :: Proxy nT)
    isSigned :: SizedInt nT -> Bool
isSigned SizedInt nT
_ = Bool
True


showSizedIntTypeProxy :: forall nT. Num.Natural nT => Proxy nT -> String
showSizedIntTypeProxy :: Proxy nT -> String
showSizedIntTypeProxy Proxy nT
n =
   String
"SizedInt " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show (Proxy nT -> Integer
forall x y. (Integer x, Num y) => Proxy x -> y
Num.fromInteger Proxy nT
n :: Integer)

showSizedIntType :: forall nT. Num.Natural nT => SizedInt nT -> String
showSizedIntType :: SizedInt nT -> String
showSizedIntType SizedInt nT
_ = Proxy nT -> String
forall nT. Natural nT => Proxy nT -> String
showSizedIntTypeProxy (Proxy nT
forall a. Proxy a
Proxy :: Proxy nT)