{-# LANGUAGE Haskell2010, ScopedTypeVariables, CPP,
             DeriveDataTypeable, DataKinds, KindSignatures,
             TypeFamilies, TypeOperators, UndecidableInstances #-}

module Data.Word.Odd (
    -- * Odd Word Wrapper
    OddWord,

    -- * Type Numbers
    TypeNum,
    One,
    Zero,
    Lit,

    -- * Finite Bits
    FiniteBitsBase(
        subWordClz,
        subWordCtz),

    -- * Predefined Odd Words
    Word1, Word2, Word3, Word4, Word5, Word6, Word7,
    Word9,  Word10, Word11, Word12, Word13, Word14, Word15,
    Word17, Word18, Word19, Word20, Word21, Word22, Word23, Word24,
    Word25, Word26, Word27, Word28, Word29, Word30, Word31,
    Word33, Word34, Word35, Word36, Word37, Word38, Word39, Word40,
    Word41, Word42, Word43, Word44, Word45, Word46, Word47, Word48,
    Word49, Word50, Word51, Word52, Word53, Word54, Word55, Word56,
    Word57, Word58, Word59, Word60, Word61, Word62, Word63
) where

import Data.Bits
import Data.Proxy
import Data.Word
import Data.Function
import Data.Typeable
import GHC.TypeLits

-- | 'OddWord' provides a range of unsigned integer word types with a length in
-- bits encoded at the type level. The first type parameter @a@ must supply an
-- integer type which can hold at least as many bits as required for the
-- 'OddWord'. The second type paramter @n@ then encodes the length in bits
-- which the 'OddWord' will be restricted to.
--
-- The length of the 'OddWord' can be encoded as a string of binary digits
-- using the 'One', 'Zero', and @()@ type constructors. The outermost
-- constructor specifies the most significant digit and each subsequent digit
-- is nested inside the previous type constructor via its type parameter. Hence,
-- the encoding is terminated by the @()@ type constructor. For example, the
-- number 4 would be expressed as: @One (Zero (Zero ()))@.
--
-- Alternatively, if the compiler supports type-level naturals then these can
-- be used via the 'Lit' type constructor. For example, the number 4 can be
-- expressed as: @Lit 4@.
--
-- To supply a complete example, a 4-bit integer type could be built from a
-- 'Word8' and specified as either @OddWord Word8 (One (Zero (Zero ())))@ or
-- @OddWord Word8 (Lit 4)@.
--
-- The behaviour of an 'OddWord' is undefined if the specified length is
-- greater than that of the underlying integer type. The behaviour is also
-- undefined if the specified length is equal to that of the underlying integer
-- type and that type is also signed.
newtype OddWord a n = OW {OddWord a n -> a
unOW :: a} deriving (OddWord a n -> OddWord a n -> Bool
(OddWord a n -> OddWord a n -> Bool)
-> (OddWord a n -> OddWord a n -> Bool) -> Eq (OddWord a n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a n. Eq a => OddWord a n -> OddWord a n -> Bool
/= :: OddWord a n -> OddWord a n -> Bool
$c/= :: forall a n. Eq a => OddWord a n -> OddWord a n -> Bool
== :: OddWord a n -> OddWord a n -> Bool
$c== :: forall a n. Eq a => OddWord a n -> OddWord a n -> Bool
Eq, Eq (OddWord a n)
Eq (OddWord a n)
-> (OddWord a n -> OddWord a n -> Ordering)
-> (OddWord a n -> OddWord a n -> Bool)
-> (OddWord a n -> OddWord a n -> Bool)
-> (OddWord a n -> OddWord a n -> Bool)
-> (OddWord a n -> OddWord a n -> Bool)
-> (OddWord a n -> OddWord a n -> OddWord a n)
-> (OddWord a n -> OddWord a n -> OddWord a n)
-> Ord (OddWord a n)
OddWord a n -> OddWord a n -> Bool
OddWord a n -> OddWord a n -> Ordering
OddWord a n -> OddWord a n -> OddWord a n
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a n. Ord a => Eq (OddWord a n)
forall a n. Ord a => OddWord a n -> OddWord a n -> Bool
forall a n. Ord a => OddWord a n -> OddWord a n -> Ordering
forall a n. Ord a => OddWord a n -> OddWord a n -> OddWord a n
min :: OddWord a n -> OddWord a n -> OddWord a n
$cmin :: forall a n. Ord a => OddWord a n -> OddWord a n -> OddWord a n
max :: OddWord a n -> OddWord a n -> OddWord a n
$cmax :: forall a n. Ord a => OddWord a n -> OddWord a n -> OddWord a n
>= :: OddWord a n -> OddWord a n -> Bool
$c>= :: forall a n. Ord a => OddWord a n -> OddWord a n -> Bool
> :: OddWord a n -> OddWord a n -> Bool
$c> :: forall a n. Ord a => OddWord a n -> OddWord a n -> Bool
<= :: OddWord a n -> OddWord a n -> Bool
$c<= :: forall a n. Ord a => OddWord a n -> OddWord a n -> Bool
< :: OddWord a n -> OddWord a n -> Bool
$c< :: forall a n. Ord a => OddWord a n -> OddWord a n -> Bool
compare :: OddWord a n -> OddWord a n -> Ordering
$ccompare :: forall a n. Ord a => OddWord a n -> OddWord a n -> Ordering
$cp1Ord :: forall a n. Ord a => Eq (OddWord a n)
Ord, Typeable)

data TypeNumBuilder a = TypeNumBuilder Int Int

fromTypeNum :: TypeNumBuilder a -> Int
fromTypeNum :: TypeNumBuilder a -> Int
fromTypeNum (TypeNumBuilder Int
x Int
_) = Int
x

-- | Intances of 'TypeNum' represent type-level numbers.
class TypeNum a where
    typeNum :: TypeNumBuilder a

-- | Represents a type-level number with a leading one bit followed by the
-- string of digits specified by @a@.
data One a deriving Typeable

-- | Represents a type-level number with a placeholder zero bit followed by the
-- string of digits specified by @a@.
data Zero a deriving Typeable

-- | Converts a native GHC type-level natural into one usable by this library.
-- This requires the @DataKinds@ extension.
data Lit :: Nat -> * deriving Typeable

instance TypeNum () where
    typeNum :: TypeNumBuilder ()
typeNum = Int -> Int -> TypeNumBuilder ()
forall a. Int -> Int -> TypeNumBuilder a
TypeNumBuilder Int
0 Int
0

instance (TypeNum a) => TypeNum (One a) where
    typeNum :: TypeNumBuilder (One a)
typeNum = let (TypeNumBuilder Int
n Int
m) = (TypeNumBuilder a
forall a. TypeNum a => TypeNumBuilder a
typeNum :: TypeNumBuilder a)
              in Int -> Int -> TypeNumBuilder (One a)
forall a. Int -> Int -> TypeNumBuilder a
TypeNumBuilder (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int -> Int
forall a. Bits a => Int -> a
bit Int
m) (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

instance (TypeNum a) => TypeNum (Zero a) where
    typeNum :: TypeNumBuilder (Zero a)
typeNum = let (TypeNumBuilder Int
n Int
m) = (TypeNumBuilder a
forall a. TypeNum a => TypeNumBuilder a
typeNum :: TypeNumBuilder a)
              in Int -> Int -> TypeNumBuilder (Zero a)
forall a. Int -> Int -> TypeNumBuilder a
TypeNumBuilder (Int
n) (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

-- | Provides a more efficient mechanism for converting 'Nat'-kinded types into
-- small integers than 'KnownNat'.
#if MIN_VERSION_base(4,11,0)
-- Decomposes Nats in log2(n) recursions, one bit at a time.
data ZNat = IsZ | NonZE Nat | NonZO Nat

type family ToZNatImpl (n::Nat) (lsb::Nat) where
    ToZNatImpl 0 0 = IsZ
    ToZNatImpl n 0 = NonZE n
    ToZNatImpl n 1 = NonZO n

type ToZNat n = ToZNatImpl n (Mod n 2)

class ZNatValue (n::ZNat) where
    znatIntVal :: proxy n -> Int

instance ZNatValue IsZ where
    znatIntVal :: proxy 'IsZ -> Int
znatIntVal proxy 'IsZ
_ = Int
0
    {-# INLINE znatIntVal #-}

instance ZNatValue (ToZNat (Div n 2)) => ZNatValue (NonZE n) where
    znatIntVal :: proxy ('NonZE n) -> Int
znatIntVal proxy ('NonZE n)
_ = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Proxy (ToZNat (Div n 2)) -> Int
forall (n :: ZNat) (proxy :: ZNat -> *).
ZNatValue n =>
proxy n -> Int
znatIntVal (Proxy (ToZNat (Div n 2))
forall k (t :: k). Proxy t
Proxy :: Proxy (ToZNat (Div n 2))))
    {-# INLINE znatIntVal #-}

instance ZNatValue (ToZNat (Div n 2)) => ZNatValue (NonZO n) where
    znatIntVal :: proxy ('NonZO n) -> Int
znatIntVal proxy ('NonZO n)
_ = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Proxy (ToZNat (Div n 2)) -> Int
forall (n :: ZNat) (proxy :: ZNat -> *).
ZNatValue n =>
proxy n -> Int
znatIntVal (Proxy (ToZNat (Div n 2))
forall k (t :: k). Proxy t
Proxy :: Proxy (ToZNat (Div n 2))))
    {-# INLINE znatIntVal #-}
#else
-- For older GHCs that don't support Div and Mod, decomposes Nats in
-- 16*log16(n) recursions for values of n below 2^16.
data ZNat = IsZ | NonZ Nat | NonZ4 Nat | NonZ8 Nat | NonZ12 Nat

-- Regarding u, v, and w, GHC 7.10 doesn't like wildcards in type families.
type family ToZNatImpl
        (n::Nat) (nz4::Ordering) (nz8::Ordering) (nz12::Ordering) where
    ToZNatImpl 0 LT LT LT = IsZ
    ToZNatImpl n LT LT LT = NonZ n
    ToZNatImpl n u  LT LT = NonZ4 n
    ToZNatImpl n u  v  LT = NonZ8 n
    ToZNatImpl n u  v  w  = NonZ12 n

type ToZNat n = ToZNatImpl n (CmpNat n 16) (CmpNat n 256) (CmpNat n 4096)

class ZNatValue (n::ZNat) where
    znatIntVal :: proxy n -> Int

instance ZNatValue IsZ where
    znatIntVal _ = 0
    {-# INLINE znatIntVal #-}

instance ZNatValue (ToZNat (n - 1)) => ZNatValue (NonZ n) where
    znatIntVal _ = 1 + (znatIntVal (Proxy :: Proxy (ToZNat (n - 1))))
    {-# INLINE znatIntVal #-}

instance ZNatValue (ToZNat (n - 16)) => ZNatValue (NonZ4 n) where
    znatIntVal _ = 16 + (znatIntVal (Proxy :: Proxy (ToZNat (n - 16))))
    {-# INLINE znatIntVal #-}

instance ZNatValue (ToZNat (n - 256)) => ZNatValue (NonZ8 n) where
    znatIntVal _ = 256 + (znatIntVal (Proxy :: Proxy (ToZNat (n - 256))))
    {-# INLINE znatIntVal #-}

instance ZNatValue (ToZNat (n - 4096)) => ZNatValue (NonZ12 n) where
    znatIntVal _ = 4096 + (znatIntVal (Proxy :: Proxy (ToZNat (n - 4096))))
    {-# INLINE znatIntVal #-}
#endif

instance (ZNatValue (ToZNat n)) => TypeNum (Lit n) where
    typeNum :: TypeNumBuilder (Lit n)
typeNum = Int -> Int -> TypeNumBuilder (Lit n)
forall a. Int -> Int -> TypeNumBuilder a
TypeNumBuilder
        (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Proxy (ToZNat n) -> Int
forall (n :: ZNat) (proxy :: ZNat -> *).
ZNatValue n =>
proxy n -> Int
znatIntVal (Proxy (ToZNat n)
forall k (t :: k). Proxy t
Proxy :: Proxy (ToZNat n))) Int
0

-- | Required to implement 'FiniteBits' for an 'OddWord' based on type @a@.
class Bits a => FiniteBitsBase a where
    -- | Count the leading zeros on a @w@-bit wide word.
    subWordClz :: Int -> a -> Int
    subWordClz Int
w a
x = (Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int
worker (Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
        where worker :: Int -> Int
worker Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0       = Int
i
                       | a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
x Int
i = Int
i
                       | Bool
otherwise   = Int -> Int
worker (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
    -- | Count the trailing zeros on a @w@-bit wide word.
    subWordCtz :: Int -> a -> Int
    subWordCtz Int
w a
x = Int -> Int
worker Int
0
        where worker :: Int -> Int
worker Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
w      = Int
i
                       | a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
x Int
i = Int
i
                       | Bool
otherwise   = Int -> Int
worker (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

instance FiniteBitsBase Word8 where
    subWordClz :: Int -> Word8 -> Int
subWordClz Int
w Word8
x = Word8 -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros Word8
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word8 -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize Word8
x
    subWordCtz :: Int -> Word8 -> Int
subWordCtz Int
w Word8
x = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Word8 -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros Word8
x) Int
w

instance FiniteBitsBase Word16 where
    subWordClz :: Int -> Word16 -> Int
subWordClz Int
w Word16
x = Word16 -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros Word16
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word16 -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize Word16
x
    subWordCtz :: Int -> Word16 -> Int
subWordCtz Int
w Word16
x = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Word16 -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros Word16
x) Int
w

instance FiniteBitsBase Word32 where
    subWordClz :: Int -> Word32 -> Int
subWordClz Int
w Word32
x = Word32 -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros Word32
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word32 -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize Word32
x
    subWordCtz :: Int -> Word32 -> Int
subWordCtz Int
w Word32
x = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Word32 -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros Word32
x) Int
w

instance FiniteBitsBase Word64 where
    subWordClz :: Int -> Word64 -> Int
subWordClz Int
w Word64
x = Word64 -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros Word64
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word64 -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize Word64
x
    subWordCtz :: Int -> Word64 -> Int
subWordCtz Int
w Word64
x = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Word64 -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros Word64
x) Int
w

instance FiniteBitsBase Integer where

-- | Wraps both parts of a homogenous pair with the OddWord constructor.
pairOW :: (a, a) -> (OddWord a n, OddWord a n)
pairOW :: (a, a) -> (OddWord a n, OddWord a n)
pairOW = (a -> a -> (OddWord a n, OddWord a n))
-> (a, a) -> (OddWord a n, OddWord a n)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((,) (OddWord a n -> OddWord a n -> (OddWord a n, OddWord a n))
-> (a -> OddWord a n) -> a -> a -> (OddWord a n, OddWord a n)
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` a -> OddWord a n
forall a n. a -> OddWord a n
OW)

-- | An OddWord with all the bits set, used for masking.
owMask :: forall a n. (Num a, Bits a, TypeNum n) => OddWord a n
owMask :: OddWord a n
owMask = a -> OddWord a n
forall a n. a -> OddWord a n
OW (a -> OddWord a n) -> (Int -> a) -> Int -> OddWord a n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> a -> a) -> a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (-) a
1) (a -> a) -> (Int -> a) -> Int -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a
forall a. Bits a => Int -> a
bit (Int -> OddWord a n) -> Int -> OddWord a n
forall a b. (a -> b) -> a -> b
$ TypeNumBuilder n -> Int
forall a. TypeNumBuilder a -> Int
fromTypeNum (TypeNumBuilder n
forall a. TypeNum a => TypeNumBuilder a
typeNum :: TypeNumBuilder n)

-- | Smart constructor for OddWords which masks off the unused upper bits.
maskOW :: forall a n. (Num a, Bits a, TypeNum n) => a -> OddWord a n
maskOW :: a -> OddWord a n
maskOW a
w = a -> OddWord a n
forall a n. a -> OddWord a n
OW (a -> OddWord a n) -> a -> OddWord a n
forall a b. (a -> b) -> a -> b
$ a
w a -> a -> a
forall a. Bits a => a -> a -> a
.&. OddWord a n -> a
forall a n. OddWord a n -> a
unOW (OddWord a n
forall a n. (Num a, Bits a, TypeNum n) => OddWord a n
owMask :: OddWord a n)

-- | Applies a function to the first component of each pair in a list thereof.
mapFst :: (a -> b) -> [(a, c)] -> [(b, c)]
mapFst :: (a -> b) -> [(a, c)] -> [(b, c)]
mapFst a -> b
f [(a, c)]
xs = ((a, c) -> (b, c)) -> [(a, c)] -> [(b, c)]
forall a b. (a -> b) -> [a] -> [b]
map (\(a
a,c
c) -> (a -> b
f a
a,c
c)) [(a, c)]
xs

--
-- Instances for the OddWord type
--
-- The instances largely forward operations to the underlying integer type
-- while wrapping and unwrapping the newtype, and masking or otherwise
-- adjusting the results as appropriate for the desired bit length of the word.
--

instance (Show a) => Show (OddWord a n) where
    showsPrec :: Int -> OddWord a n -> ShowS
showsPrec Int
p (OW a
x) String
s = Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p a
x String
s
    show :: OddWord a n -> String
show (OW a
x)          = a -> String
forall a. Show a => a -> String
show a
x
    showList :: [OddWord a n] -> ShowS
showList [OddWord a n]
xs          = [a] -> ShowS
forall a. Show a => [a] -> ShowS
showList ([a] -> ShowS) -> [a] -> ShowS
forall a b. (a -> b) -> a -> b
$ (OddWord a n -> a) -> [OddWord a n] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map OddWord a n -> a
forall a n. OddWord a n -> a
unOW [OddWord a n]
xs 

instance (Read a, Num a, Bits a, TypeNum n) => Read (OddWord a n) where
    readsPrec :: Int -> ReadS (OddWord a n)
readsPrec Int
p String
s = (a -> OddWord a n) -> [(a, String)] -> [(OddWord a n, String)]
forall a b c. (a -> b) -> [(a, c)] -> [(b, c)]
mapFst a -> OddWord a n
forall a n. (Num a, Bits a, TypeNum n) => a -> OddWord a n
maskOW ([(a, String)] -> [(OddWord a n, String)])
-> [(a, String)] -> [(OddWord a n, String)]
forall a b. (a -> b) -> a -> b
$ Int -> ReadS a
forall a. Read a => Int -> ReadS a
readsPrec Int
p String
s
    readList :: ReadS [OddWord a n]
readList String
s    = ([a] -> [OddWord a n])
-> [([a], String)] -> [([OddWord a n], String)]
forall a b c. (a -> b) -> [(a, c)] -> [(b, c)]
mapFst ((a -> OddWord a n) -> [a] -> [OddWord a n]
forall a b. (a -> b) -> [a] -> [b]
map a -> OddWord a n
forall a n. (Num a, Bits a, TypeNum n) => a -> OddWord a n
maskOW) ([([a], String)] -> [([OddWord a n], String)])
-> [([a], String)] -> [([OddWord a n], String)]
forall a b. (a -> b) -> a -> b
$ ReadS [a]
forall a. Read a => ReadS [a]
readList String
s

instance (Num a, Bits a, TypeNum n) => Num (OddWord a n) where
    (OW a
l) + :: OddWord a n -> OddWord a n -> OddWord a n
+ (OW a
r) = a -> OddWord a n
forall a n. (Num a, Bits a, TypeNum n) => a -> OddWord a n
maskOW (a -> OddWord a n) -> a -> OddWord a n
forall a b. (a -> b) -> a -> b
$ (a
l a -> a -> a
forall a. Num a => a -> a -> a
+ a
r)
    (OW a
l) * :: OddWord a n -> OddWord a n -> OddWord a n
* (OW a
r) = a -> OddWord a n
forall a n. (Num a, Bits a, TypeNum n) => a -> OddWord a n
maskOW (a -> OddWord a n) -> a -> OddWord a n
forall a b. (a -> b) -> a -> b
$ (a
l a -> a -> a
forall a. Num a => a -> a -> a
* a
r)
    (OW a
l) - :: OddWord a n -> OddWord a n -> OddWord a n
- (OW a
r) = a -> OddWord a n
forall a n. (Num a, Bits a, TypeNum n) => a -> OddWord a n
maskOW (a -> OddWord a n) -> a -> OddWord a n
forall a b. (a -> b) -> a -> b
$ (a
l a -> a -> a
forall a. Num a => a -> a -> a
- a
r)
    negate :: OddWord a n -> OddWord a n
negate (OW a
x)   = a -> OddWord a n
forall a n. (Num a, Bits a, TypeNum n) => a -> OddWord a n
maskOW (a -> OddWord a n) -> a -> OddWord a n
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Num a => a -> a
negate a
x
    abs :: OddWord a n -> OddWord a n
abs OddWord a n
w = OddWord a n
w
    signum :: OddWord a n -> OddWord a n
signum (OW a
x) | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0    = OddWord a n
0
                  | Bool
otherwise = OddWord a n
1
    fromInteger :: Integer -> OddWord a n
fromInteger Integer
i = a -> OddWord a n
forall a n. (Num a, Bits a, TypeNum n) => a -> OddWord a n
maskOW (a -> OddWord a n) -> a -> OddWord a n
forall a b. (a -> b) -> a -> b
$ Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i 

instance (Real a, Bits a, TypeNum n) => Real (OddWord a n) where
    toRational :: OddWord a n -> Rational
toRational (OW a
x) = a -> Rational
forall a. Real a => a -> Rational
toRational a
x

instance (Num a, Bits a, TypeNum n) => Bounded (OddWord a n) where
    minBound :: OddWord a n
minBound = OddWord a n
0
    maxBound :: OddWord a n
maxBound = OddWord a n
forall a n. (Num a, Bits a, TypeNum n) => OddWord a n
owMask

instance (Enum a, Ord a, Num a, Bits a, TypeNum n) => Enum (OddWord a n) where
    succ :: OddWord a n -> OddWord a n
succ OddWord a n
x = OddWord a n
x OddWord a n -> OddWord a n -> OddWord a n
forall a. Num a => a -> a -> a
+ OddWord a n
1
    pred :: OddWord a n -> OddWord a n
pred OddWord a n
x = OddWord a n
x OddWord a n -> OddWord a n -> OddWord a n
forall a. Num a => a -> a -> a
- OddWord a n
1
    toEnum :: Int -> OddWord a n
toEnum Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= OddWord a n -> a
forall a n. OddWord a n -> a
unOW (OddWord a n
forall a n. (Num a, Bits a, TypeNum n) => OddWord a n
owMask :: OddWord a n)
             = a -> OddWord a n
forall a n. a -> OddWord a n
OW (a -> OddWord a n) -> a -> OddWord a n
forall a b. (a -> b) -> a -> b
$ Int -> a
forall a. Enum a => Int -> a
toEnum Int
i
             | Bool
otherwise = String -> OddWord a n
forall a. HasCallStack => String -> a
error String
"OddWord: toEnum: Index out of bounds."
    fromEnum :: OddWord a n -> Int
fromEnum (OW a
x) = a -> Int
forall a. Enum a => a -> Int
fromEnum a
x
    enumFrom :: OddWord a n -> [OddWord a n]
enumFrom OddWord a n
x = OddWord a n -> OddWord a n -> [OddWord a n]
forall a. Enum a => a -> a -> [a]
enumFromTo OddWord a n
x OddWord a n
forall a n. (Num a, Bits a, TypeNum n) => OddWord a n
owMask
    enumFromThen :: OddWord a n -> OddWord a n -> [OddWord a n]
enumFromThen OddWord a n
x1 OddWord a n
x2 = OddWord a n -> OddWord a n -> OddWord a n -> [OddWord a n]
forall a. Enum a => a -> a -> a -> [a]
enumFromThenTo OddWord a n
x1 OddWord a n
x2 OddWord a n
bound
                         where bound :: OddWord a n
bound | OddWord a n
x2 OddWord a n -> OddWord a n -> Bool
forall a. Ord a => a -> a -> Bool
>= OddWord a n
x1 = OddWord a n
forall a n. (Num a, Bits a, TypeNum n) => OddWord a n
owMask
                                     | Bool
otherwise = OddWord a n
0
    enumFromTo :: OddWord a n -> OddWord a n -> [OddWord a n]
enumFromTo (OW a
x) (OW a
y) = (a -> OddWord a n) -> [a] -> [OddWord a n]
forall a b. (a -> b) -> [a] -> [b]
map a -> OddWord a n
forall a n. a -> OddWord a n
OW ([a] -> [OddWord a n]) -> [a] -> [OddWord a n]
forall a b. (a -> b) -> a -> b
$ a -> a -> [a]
forall a. Enum a => a -> a -> [a]
enumFromTo a
x a
y
    enumFromThenTo :: OddWord a n -> OddWord a n -> OddWord a n -> [OddWord a n]
enumFromThenTo (OW a
x1) (OW a
x2) (OW a
y) = (a -> OddWord a n) -> [a] -> [OddWord a n]
forall a b. (a -> b) -> [a] -> [b]
map a -> OddWord a n
forall a n. a -> OddWord a n
OW ([a] -> [OddWord a n]) -> [a] -> [OddWord a n]
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> [a]
forall a. Enum a => a -> a -> a -> [a]
enumFromThenTo a
x1 a
x2 a
y

instance (Integral a, Bits a, TypeNum n) => Integral (OddWord a n) where
    quot :: OddWord a n -> OddWord a n -> OddWord a n
quot (OW a
n) (OW a
d) = a -> OddWord a n
forall a n. a -> OddWord a n
OW (a -> OddWord a n) -> a -> OddWord a n
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall a. Integral a => a -> a -> a
quot a
n a
d
    rem :: OddWord a n -> OddWord a n -> OddWord a n
rem  (OW a
n) (OW a
d) = a -> OddWord a n
forall a n. a -> OddWord a n
OW (a -> OddWord a n) -> a -> OddWord a n
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall a. Integral a => a -> a -> a
rem a
n a
d
    div :: OddWord a n -> OddWord a n -> OddWord a n
div  (OW a
n) (OW a
d) = a -> OddWord a n
forall a n. a -> OddWord a n
OW (a -> OddWord a n) -> a -> OddWord a n
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall a. Integral a => a -> a -> a
div a
n a
d
    mod :: OddWord a n -> OddWord a n -> OddWord a n
mod  (OW a
n) (OW a
d) = a -> OddWord a n
forall a n. a -> OddWord a n
OW (a -> OddWord a n) -> a -> OddWord a n
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall a. Integral a => a -> a -> a
mod a
n a
d
    quotRem :: OddWord a n -> OddWord a n -> (OddWord a n, OddWord a n)
quotRem (OW a
n) (OW a
d) = (a, a) -> (OddWord a n, OddWord a n)
forall a n. (a, a) -> (OddWord a n, OddWord a n)
pairOW ((a, a) -> (OddWord a n, OddWord a n))
-> (a, a) -> (OddWord a n, OddWord a n)
forall a b. (a -> b) -> a -> b
$ a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
quotRem a
n a
d
    divMod :: OddWord a n -> OddWord a n -> (OddWord a n, OddWord a n)
divMod  (OW a
n) (OW a
d) = (a, a) -> (OddWord a n, OddWord a n)
forall a n. (a, a) -> (OddWord a n, OddWord a n)
pairOW ((a, a) -> (OddWord a n, OddWord a n))
-> (a, a) -> (OddWord a n, OddWord a n)
forall a b. (a -> b) -> a -> b
$ a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
divMod a
n a
d
    toInteger :: OddWord a n -> Integer
toInteger (OW a
x) = a -> Integer
forall a. Integral a => a -> Integer
toInteger a
x

instance (Num a, Bits a, TypeNum n) => Bits (OddWord a n) where
    (OW a
l) .&. :: OddWord a n -> OddWord a n -> OddWord a n
.&. (OW a
r) = a -> OddWord a n
forall a n. a -> OddWord a n
OW (a -> OddWord a n) -> a -> OddWord a n
forall a b. (a -> b) -> a -> b
$ a
l a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
r
    (OW a
l) .|. :: OddWord a n -> OddWord a n -> OddWord a n
.|. (OW a
r) = a -> OddWord a n
forall a n. a -> OddWord a n
OW (a -> OddWord a n) -> a -> OddWord a n
forall a b. (a -> b) -> a -> b
$ a
l a -> a -> a
forall a. Bits a => a -> a -> a
.|. a
r
    xor :: OddWord a n -> OddWord a n -> OddWord a n
xor (OW a
l) (OW a
r) = a -> OddWord a n
forall a n. a -> OddWord a n
OW (a -> OddWord a n) -> a -> OddWord a n
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall a. Bits a => a -> a -> a
xor a
l a
r
    complement :: OddWord a n -> OddWord a n
complement OddWord a n
x = OddWord a n
x OddWord a n -> OddWord a n -> OddWord a n
forall a. Bits a => a -> a -> a
`xor` OddWord a n
forall a n. (Num a, Bits a, TypeNum n) => OddWord a n
owMask
    bit :: Int -> OddWord a n
bit Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< TypeNumBuilder n -> Int
forall a. TypeNumBuilder a -> Int
fromTypeNum (TypeNumBuilder n
forall a. TypeNum a => TypeNumBuilder a
typeNum :: TypeNumBuilder n)
          = a -> OddWord a n
forall a n. a -> OddWord a n
OW (a -> OddWord a n) -> a -> OddWord a n
forall a b. (a -> b) -> a -> b
$ Int -> a
forall a. Bits a => Int -> a
bit Int
n
          | Bool
otherwise = a -> OddWord a n
forall a n. a -> OddWord a n
OW a
0
    setBit :: OddWord a n -> Int -> OddWord a n
setBit (OW a
x) Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< TypeNumBuilder n -> Int
forall a. TypeNumBuilder a -> Int
fromTypeNum (TypeNumBuilder n
forall a. TypeNum a => TypeNumBuilder a
typeNum :: TypeNumBuilder n)
                    = a -> OddWord a n
forall a n. a -> OddWord a n
OW (a -> OddWord a n) -> a -> OddWord a n
forall a b. (a -> b) -> a -> b
$ a -> Int -> a
forall a. Bits a => a -> Int -> a
setBit a
x Int
n
                    | Bool
otherwise = a -> OddWord a n
forall a n. a -> OddWord a n
OW a
x
    clearBit :: OddWord a n -> Int -> OddWord a n
clearBit (OW a
x) Int
n = a -> OddWord a n
forall a n. a -> OddWord a n
OW (a -> OddWord a n) -> a -> OddWord a n
forall a b. (a -> b) -> a -> b
$ a -> Int -> a
forall a. Bits a => a -> Int -> a
clearBit a
x Int
n
    complementBit :: OddWord a n -> Int -> OddWord a n
complementBit (OW a
x) Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< TypeNumBuilder n -> Int
forall a. TypeNumBuilder a -> Int
fromTypeNum (TypeNumBuilder n
forall a. TypeNum a => TypeNumBuilder a
typeNum :: TypeNumBuilder n)
                           = a -> OddWord a n
forall a n. a -> OddWord a n
OW (a -> OddWord a n) -> a -> OddWord a n
forall a b. (a -> b) -> a -> b
$ a -> Int -> a
forall a. Bits a => a -> Int -> a
complementBit a
x Int
n
                           | Bool
otherwise = a -> OddWord a n
forall a n. a -> OddWord a n
OW a
x
    testBit :: OddWord a n -> Int -> Bool
testBit (OW a
x) Int
n = a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
x Int
n
    bitSize :: OddWord a n -> Int
bitSize OddWord a n
_ = TypeNumBuilder n -> Int
forall a. TypeNumBuilder a -> Int
fromTypeNum (TypeNumBuilder n
forall a. TypeNum a => TypeNumBuilder a
typeNum :: TypeNumBuilder n)
    bitSizeMaybe :: OddWord a n -> Maybe Int
bitSizeMaybe OddWord a n
_ = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ TypeNumBuilder n -> Int
forall a. TypeNumBuilder a -> Int
fromTypeNum (TypeNumBuilder n
forall a. TypeNum a => TypeNumBuilder a
typeNum :: TypeNumBuilder n)
    isSigned :: OddWord a n -> Bool
isSigned OddWord a n
_ = Bool
False 
    shiftL :: OddWord a n -> Int -> OddWord a n
shiftL (OW a
x) Int
n = a -> OddWord a n
forall a n. (Num a, Bits a, TypeNum n) => a -> OddWord a n
maskOW (a -> OddWord a n) -> a -> OddWord a n
forall a b. (a -> b) -> a -> b
$ a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftL a
x Int
n
    shiftR :: OddWord a n -> Int -> OddWord a n
shiftR (OW a
x) Int
n = a -> OddWord a n
forall a n. a -> OddWord a n
OW (a -> OddWord a n) -> a -> OddWord a n
forall a b. (a -> b) -> a -> b
$ a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftR a
x Int
n
    rotateL :: OddWord a n -> Int -> OddWord a n
rotateL (OW a
x) Int
n = a -> OddWord a n
forall a n. a -> OddWord a n
OW (a -> OddWord a n) -> a -> OddWord a n
forall a b. (a -> b) -> a -> b
$
        (a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftL a
x Int
n' a -> a -> a
forall a. Bits a => a -> a -> a
.&. OddWord a n -> a
forall a n. OddWord a n -> a
unOW (OddWord a n
forall a n. (Num a, Bits a, TypeNum n) => OddWord a n
owMask :: OddWord a n)) a -> a -> a
forall a. Bits a => a -> a -> a
.|. a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftR a
x (Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n')
        where n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
w
              w :: Int
w = TypeNumBuilder n -> Int
forall a. TypeNumBuilder a -> Int
fromTypeNum (TypeNumBuilder n
forall a. TypeNum a => TypeNumBuilder a
typeNum :: TypeNumBuilder n)
    rotateR :: OddWord a n -> Int -> OddWord a n
rotateR (OW a
x) Int
n = a -> OddWord a n
forall a n. a -> OddWord a n
OW (a -> OddWord a n) -> a -> OddWord a n
forall a b. (a -> b) -> a -> b
$
        a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftR a
x Int
n' a -> a -> a
forall a. Bits a => a -> a -> a
.|. (a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftL a
x (Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n') a -> a -> a
forall a. Bits a => a -> a -> a
.&. OddWord a n -> a
forall a n. OddWord a n -> a
unOW (OddWord a n
forall a n. (Num a, Bits a, TypeNum n) => OddWord a n
owMask :: OddWord a n))
        where n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
w
              w :: Int
w  = TypeNumBuilder n -> Int
forall a. TypeNumBuilder a -> Int
fromTypeNum (TypeNumBuilder n
forall a. TypeNum a => TypeNumBuilder a
typeNum :: TypeNumBuilder n)
    popCount :: OddWord a n -> Int
popCount (OW a
x) = a -> Int
forall a. Bits a => a -> Int
popCount a
x

instance (Num a, FiniteBitsBase a, TypeNum n) => FiniteBits (OddWord a n) where
    finiteBitSize :: OddWord a n -> Int
finiteBitSize OddWord a n
_ = TypeNumBuilder n -> Int
forall a. TypeNumBuilder a -> Int
fromTypeNum (TypeNumBuilder n
forall a. TypeNum a => TypeNumBuilder a
typeNum :: TypeNumBuilder n) 
    countLeadingZeros :: OddWord a n -> Int
countLeadingZeros (OW a
x) =
        Int -> a -> Int
forall a. FiniteBitsBase a => Int -> a -> Int
subWordClz (TypeNumBuilder n -> Int
forall a. TypeNumBuilder a -> Int
fromTypeNum (TypeNumBuilder n
forall a. TypeNum a => TypeNumBuilder a
typeNum :: TypeNumBuilder n)) a
x
    countTrailingZeros :: OddWord a n -> Int
countTrailingZeros (OW a
x) =
        Int -> a -> Int
forall a. FiniteBitsBase a => Int -> a -> Int
subWordCtz (TypeNumBuilder n -> Int
forall a. TypeNumBuilder a -> Int
fromTypeNum (TypeNumBuilder n
forall a. TypeNum a => TypeNumBuilder a
typeNum :: TypeNumBuilder n)) a
x

--
-- Predefined Odd Words
--

type Word1  = OddWord Word8             (One  ())
type Word2  = OddWord Word8        (One (Zero ()))
type Word3  = OddWord Word8        (One (One  ()))
type Word4  = OddWord Word8  (One (Zero (Zero ())))
type Word5  = OddWord Word8  (One (Zero (One  ())))
type Word6  = OddWord Word8  (One (One  (Zero ())))
type Word7  = OddWord Word8  (One (One  (One  ())))
--type Word8
type Word9  = OddWord Word16 (One (Zero (Zero (One  ()))))
type Word10 = OddWord Word16 (One (Zero (One  (Zero ()))))
type Word11 = OddWord Word16 (One (Zero (One  (One  ()))))
type Word12 = OddWord Word16 (One (One  (Zero (Zero ()))))
type Word13 = OddWord Word16 (One (One  (Zero (One  ()))))
type Word14 = OddWord Word16 (One (One  (One  (Zero ()))))
type Word15 = OddWord Word16 (One (One  (One  (One  ()))))
--type Word16
type Word17 = OddWord Word32 (One (Zero (Zero (Zero (One  ())))))
type Word18 = OddWord Word32 (One (Zero (Zero (One  (Zero ())))))
type Word19 = OddWord Word32 (One (Zero (Zero (One  (One  ())))))
type Word20 = OddWord Word32 (One (Zero (One  (Zero (Zero ())))))
type Word21 = OddWord Word32 (One (Zero (One  (Zero (One  ())))))
type Word22 = OddWord Word32 (One (Zero (One  (One  (Zero ())))))
type Word23 = OddWord Word32 (One (Zero (One  (One  (One  ())))))
type Word24 = OddWord Word32 (One (One  (Zero (Zero (Zero ())))))
type Word25 = OddWord Word32 (One (One  (Zero (Zero (One  ())))))
type Word26 = OddWord Word32 (One (One  (Zero (One  (Zero ())))))
type Word27 = OddWord Word32 (One (One  (Zero (One  (One  ())))))
type Word28 = OddWord Word32 (One (One  (One  (Zero (Zero ())))))
type Word29 = OddWord Word32 (One (One  (One  (Zero (One  ())))))
type Word30 = OddWord Word32 (One (One  (One  (One  (Zero ())))))
type Word31 = OddWord Word32 (One (One  (One  (One  (One  ())))))
--type Word32
type Word33 = OddWord Word64 (One (Zero (Zero (Zero (Zero (One  ()))))))
type Word34 = OddWord Word64 (One (Zero (Zero (Zero (One  (Zero ()))))))
type Word35 = OddWord Word64 (One (Zero (Zero (Zero (One  (One  ()))))))
type Word36 = OddWord Word64 (One (Zero (Zero (One  (Zero (Zero ()))))))
type Word37 = OddWord Word64 (One (Zero (Zero (One  (Zero (One  ()))))))
type Word38 = OddWord Word64 (One (Zero (Zero (One  (One  (Zero ()))))))
type Word39 = OddWord Word64 (One (Zero (Zero (One  (One  (One  ()))))))
type Word40 = OddWord Word64 (One (Zero (One  (Zero (Zero (Zero ()))))))
type Word41 = OddWord Word64 (One (Zero (One  (Zero (Zero (One  ()))))))
type Word42 = OddWord Word64 (One (Zero (One  (Zero (One  (Zero ()))))))
type Word43 = OddWord Word64 (One (Zero (One  (Zero (One  (One  ()))))))
type Word44 = OddWord Word64 (One (Zero (One  (One  (Zero (Zero ()))))))
type Word45 = OddWord Word64 (One (Zero (One  (One  (Zero (One  ()))))))
type Word46 = OddWord Word64 (One (Zero (One  (One  (One  (Zero ()))))))
type Word47 = OddWord Word64 (One (Zero (One  (One  (One  (One  ()))))))
type Word48 = OddWord Word64 (One (One  (Zero (Zero (Zero (Zero ()))))))
type Word49 = OddWord Word64 (One (One  (Zero (Zero (Zero (One  ()))))))
type Word50 = OddWord Word64 (One (One  (Zero (Zero (One  (Zero ()))))))
type Word51 = OddWord Word64 (One (One  (Zero (Zero (One  (One  ()))))))
type Word52 = OddWord Word64 (One (One  (Zero (One  (Zero (Zero ()))))))
type Word53 = OddWord Word64 (One (One  (Zero (One  (Zero (One  ()))))))
type Word54 = OddWord Word64 (One (One  (Zero (One  (One  (Zero ()))))))
type Word55 = OddWord Word64 (One (One  (Zero (One  (One  (One  ()))))))
type Word56 = OddWord Word64 (One (One  (One  (Zero (Zero (Zero ()))))))
type Word57 = OddWord Word64 (One (One  (One  (Zero (Zero (One  ()))))))
type Word58 = OddWord Word64 (One (One  (One  (Zero (One  (Zero ()))))))
type Word59 = OddWord Word64 (One (One  (One  (Zero (One  (One  ()))))))
type Word60 = OddWord Word64 (One (One  (One  (One  (Zero (Zero ()))))))
type Word61 = OddWord Word64 (One (One  (One  (One  (Zero (One  ()))))))
type Word62 = OddWord Word64 (One (One  (One  (One  (One  (Zero ()))))))
type Word63 = OddWord Word64 (One (One  (One  (One  (One  (One  ()))))))