--------------------------------------------------------------------------------------------
--
--   Copyright   :  (C) 2022-2023 Nathan Waivio
--   License     :  BSD3
--   Maintainer  :  Nathan Waivio <nathan.waivio@gmail.com>
--   Stability   :  Stable
--   Portability :  Portable
--
-- | Library implementing standard 'Posit-3.2', and 'Posit-2022' numbers, as defined by
--   the Posit Working Group 23 June 2018, and in 2022 respectively.
-- 
-- 
---------------------------------------------------------------------------------------------


{-# LANGUAGE TypeFamilyDependencies #-} -- For the associated bidirectional type family that the Posit library is based on
{-# LANGUAGE DataKinds #-}  -- For our ES kind and the constructors Z, I, II, III, IV, V, for exponent size type
{-# LANGUAGE TypeApplications #-}  -- The most excellent syntax @Int256
{-# LANGUAGE AllowAmbiguousTypes #-} -- The Haskell/GHC Type checker seems to have trouble things in the PositC class
{-# LANGUAGE ScopedTypeVariables #-} -- To reduce some code duplication
{-# LANGUAGE FlexibleContexts #-} -- To reduce some code duplication by claiming the type family provides some constraints, that GHC can't do without fully evaluating the type family
{-# LANGUAGE ConstrainedClassMethods #-} -- Allows constraints on class methods so default implementations of methods with Type Families can be implemented
{-# LANGUAGE ConstraintKinds #-}  -- Simplify all of the constraints into a combinded constraint for the super class constraint
{-# LANGUAGE DerivingVia #-}  -- To Derive instances for newtypes to eliminate Orphan Instances
{-# LANGUAGE UndecidableInstances #-}  -- For deriving DoubleWord
{-# LANGUAGE CPP #-} -- To remove Storable instances to remove noise when performing analysis of Core
{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}  -- Turn off noise
{-# OPTIONS_GHC -Wno-type-defaults #-}  -- Turn off noise

-- ----
--  |Posit Class, implementing:
--
--   * PositC
--   * Orphan Instances of Storable for Word128, Int128, Int256
-- ----

module Posit.Internal.PositC
(PositC(..),
 ES(..),
 IntN,
 FixedWidthInteger(),
 Max,
 Next
 ) where

import Prelude hiding (exponent,significand)

-- Imports for Storable Instance of Data.DoubleWord
import Foreign.Storable (Storable, sizeOf, alignment, peek, poke)  -- Used for Storable Instances of Data.DoubleWord
import Foreign.Ptr (Ptr, plusPtr, castPtr)  -- Used for dealing with Pointers for the Data.DoubleWord Storable Instance

-- Machine Integers and Operations
{-@ embed Int128 * as int @-}
{-@ embed Int256 * as int @-}
import Data.Int (Int8,Int16,Int32,Int64)  -- Import standard Int sizes
import Data.DoubleWord (Word128,Int128,Int256,fromHiAndLo,hiWord,loWord,DoubleWord,BinaryWord) -- Import large Int sizes
import Data.Word (Word64)
import Data.Bits (Bits(..), shiftL, shift, testBit, (.&.), shiftR,FiniteBits)

-- Import Naturals and Rationals
{-@ embed Natural * as int @-}
import GHC.Natural (Natural) -- Import the Natural Numbers ℕ (u+2115)
{-@ embed Ratio * as real @-}
{-@ embed Rational * as real @-}
import Data.Ratio ((%))  -- Import the Rational Numbers ℚ (u+211A), ℚ can get arbitrarily close to Real numbers ℝ (u+211D)


-- | The Exponent Size 'ES' kind, the constructor for the Type is a Roman Numeral.
data ES = Z_3_2
        | I_3_2
        | II_3_2
        | III_3_2
        | IV_3_2
        | V_3_2
        | Z_2022
        | I_2022
        | II_2022
        | III_2022
        | IV_2022
        | V_2022

-- | Type of the Finite Precision Representation, in our case Int8, 
-- Int16, Int32, Int64, Int128, Int256.
{-@ embed IntN * as int @-}
type family IntN (es :: ES)
  where
    IntN Z_3_2   = Int8
    IntN I_3_2   = Int16
    IntN II_3_2  = Int32
    IntN III_3_2 = Int64
#ifdef O_NO_STORABLE
    IntN IV_3_2  = Int128
    IntN V_3_2   = Int256
#else
    IntN IV_3_2  = Int128_Storable
    IntN V_3_2   = Int256_Storable
#endif
    IntN Z_2022   = Int8
    IntN I_2022   = Int16
    IntN II_2022  = Int32
    IntN III_2022 = Int64
#ifdef O_NO_STORABLE
    IntN IV_2022  = Int128
    IntN V_2022   = Int256
#else
    IntN IV_2022  = Int128_Storable
    IntN V_2022   = Int256_Storable

-- | New Type Wrappers to resolve Orphan Instance Issue
newtype Int128_Storable = Int128_Storable Int128
  deriving (Eq Int128_Storable
Int128_Storable
Int -> Int128_Storable
Int128_Storable -> Bool
Int128_Storable -> Int
Int128_Storable -> Maybe Int
Int128_Storable -> Int128_Storable
Int128_Storable -> Int -> Bool
Int128_Storable -> Int -> Int128_Storable
Int128_Storable -> Int128_Storable -> Int128_Storable
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: Int128_Storable -> Int
$cpopCount :: Int128_Storable -> Int
rotateR :: Int128_Storable -> Int -> Int128_Storable
$crotateR :: Int128_Storable -> Int -> Int128_Storable
rotateL :: Int128_Storable -> Int -> Int128_Storable
$crotateL :: Int128_Storable -> Int -> Int128_Storable
unsafeShiftR :: Int128_Storable -> Int -> Int128_Storable
$cunsafeShiftR :: Int128_Storable -> Int -> Int128_Storable
shiftR :: Int128_Storable -> Int -> Int128_Storable
$cshiftR :: Int128_Storable -> Int -> Int128_Storable
unsafeShiftL :: Int128_Storable -> Int -> Int128_Storable
$cunsafeShiftL :: Int128_Storable -> Int -> Int128_Storable
shiftL :: Int128_Storable -> Int -> Int128_Storable
$cshiftL :: Int128_Storable -> Int -> Int128_Storable
isSigned :: Int128_Storable -> Bool
$cisSigned :: Int128_Storable -> Bool
bitSize :: Int128_Storable -> Int
$cbitSize :: Int128_Storable -> Int
bitSizeMaybe :: Int128_Storable -> Maybe Int
$cbitSizeMaybe :: Int128_Storable -> Maybe Int
testBit :: Int128_Storable -> Int -> Bool
$ctestBit :: Int128_Storable -> Int -> Bool
complementBit :: Int128_Storable -> Int -> Int128_Storable
$ccomplementBit :: Int128_Storable -> Int -> Int128_Storable
clearBit :: Int128_Storable -> Int -> Int128_Storable
$cclearBit :: Int128_Storable -> Int -> Int128_Storable
setBit :: Int128_Storable -> Int -> Int128_Storable
$csetBit :: Int128_Storable -> Int -> Int128_Storable
bit :: Int -> Int128_Storable
$cbit :: Int -> Int128_Storable
zeroBits :: Int128_Storable
$czeroBits :: Int128_Storable
rotate :: Int128_Storable -> Int -> Int128_Storable
$crotate :: Int128_Storable -> Int -> Int128_Storable
shift :: Int128_Storable -> Int -> Int128_Storable
$cshift :: Int128_Storable -> Int -> Int128_Storable
complement :: Int128_Storable -> Int128_Storable
$ccomplement :: Int128_Storable -> Int128_Storable
xor :: Int128_Storable -> Int128_Storable -> Int128_Storable
$cxor :: Int128_Storable -> Int128_Storable -> Int128_Storable
.|. :: Int128_Storable -> Int128_Storable -> Int128_Storable
$c.|. :: Int128_Storable -> Int128_Storable -> Int128_Storable
.&. :: Int128_Storable -> Int128_Storable -> Int128_Storable
$c.&. :: Int128_Storable -> Int128_Storable -> Int128_Storable
Bits,Int128_Storable
forall a. a -> a -> Bounded a
maxBound :: Int128_Storable
$cmaxBound :: Int128_Storable
minBound :: Int128_Storable
$cminBound :: Int128_Storable
Bounded,Int -> Int128_Storable
Int128_Storable -> Int
Int128_Storable -> [Int128_Storable]
Int128_Storable -> Int128_Storable
Int128_Storable -> Int128_Storable -> [Int128_Storable]
Int128_Storable
-> Int128_Storable -> Int128_Storable -> [Int128_Storable]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Int128_Storable
-> Int128_Storable -> Int128_Storable -> [Int128_Storable]
$cenumFromThenTo :: Int128_Storable
-> Int128_Storable -> Int128_Storable -> [Int128_Storable]
enumFromTo :: Int128_Storable -> Int128_Storable -> [Int128_Storable]
$cenumFromTo :: Int128_Storable -> Int128_Storable -> [Int128_Storable]
enumFromThen :: Int128_Storable -> Int128_Storable -> [Int128_Storable]
$cenumFromThen :: Int128_Storable -> Int128_Storable -> [Int128_Storable]
enumFrom :: Int128_Storable -> [Int128_Storable]
$cenumFrom :: Int128_Storable -> [Int128_Storable]
fromEnum :: Int128_Storable -> Int
$cfromEnum :: Int128_Storable -> Int
toEnum :: Int -> Int128_Storable
$ctoEnum :: Int -> Int128_Storable
pred :: Int128_Storable -> Int128_Storable
$cpred :: Int128_Storable -> Int128_Storable
succ :: Int128_Storable -> Int128_Storable
$csucc :: Int128_Storable -> Int128_Storable
Enum,Num Int128_Storable
Ord Int128_Storable
Int128_Storable -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Int128_Storable -> Rational
$ctoRational :: Int128_Storable -> Rational
Real,Enum Int128_Storable
Real Int128_Storable
Int128_Storable -> Integer
Int128_Storable
-> Int128_Storable -> (Int128_Storable, Int128_Storable)
Int128_Storable -> Int128_Storable -> Int128_Storable
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Int128_Storable -> Integer
$ctoInteger :: Int128_Storable -> Integer
divMod :: Int128_Storable
-> Int128_Storable -> (Int128_Storable, Int128_Storable)
$cdivMod :: Int128_Storable
-> Int128_Storable -> (Int128_Storable, Int128_Storable)
quotRem :: Int128_Storable
-> Int128_Storable -> (Int128_Storable, Int128_Storable)
$cquotRem :: Int128_Storable
-> Int128_Storable -> (Int128_Storable, Int128_Storable)
mod :: Int128_Storable -> Int128_Storable -> Int128_Storable
$cmod :: Int128_Storable -> Int128_Storable -> Int128_Storable
div :: Int128_Storable -> Int128_Storable -> Int128_Storable
$cdiv :: Int128_Storable -> Int128_Storable -> Int128_Storable
rem :: Int128_Storable -> Int128_Storable -> Int128_Storable
$crem :: Int128_Storable -> Int128_Storable -> Int128_Storable
quot :: Int128_Storable -> Int128_Storable -> Int128_Storable
$cquot :: Int128_Storable -> Int128_Storable -> Int128_Storable
Integral,Int128_Storable -> Int128_Storable -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Int128_Storable -> Int128_Storable -> Bool
$c/= :: Int128_Storable -> Int128_Storable -> Bool
== :: Int128_Storable -> Int128_Storable -> Bool
$c== :: Int128_Storable -> Int128_Storable -> Bool
Eq,Eq Int128_Storable
Int128_Storable -> Int128_Storable -> Bool
Int128_Storable -> Int128_Storable -> Ordering
Int128_Storable -> Int128_Storable -> Int128_Storable
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
min :: Int128_Storable -> Int128_Storable -> Int128_Storable
$cmin :: Int128_Storable -> Int128_Storable -> Int128_Storable
max :: Int128_Storable -> Int128_Storable -> Int128_Storable
$cmax :: Int128_Storable -> Int128_Storable -> Int128_Storable
>= :: Int128_Storable -> Int128_Storable -> Bool
$c>= :: Int128_Storable -> Int128_Storable -> Bool
> :: Int128_Storable -> Int128_Storable -> Bool
$c> :: Int128_Storable -> Int128_Storable -> Bool
<= :: Int128_Storable -> Int128_Storable -> Bool
$c<= :: Int128_Storable -> Int128_Storable -> Bool
< :: Int128_Storable -> Int128_Storable -> Bool
$c< :: Int128_Storable -> Int128_Storable -> Bool
compare :: Int128_Storable -> Int128_Storable -> Ordering
$ccompare :: Int128_Storable -> Int128_Storable -> Ordering
Ord,Integer -> Int128_Storable
Int128_Storable -> Int128_Storable
Int128_Storable -> Int128_Storable -> Int128_Storable
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Int128_Storable
$cfromInteger :: Integer -> Int128_Storable
signum :: Int128_Storable -> Int128_Storable
$csignum :: Int128_Storable -> Int128_Storable
abs :: Int128_Storable -> Int128_Storable
$cabs :: Int128_Storable -> Int128_Storable
negate :: Int128_Storable -> Int128_Storable
$cnegate :: Int128_Storable -> Int128_Storable
* :: Int128_Storable -> Int128_Storable -> Int128_Storable
$c* :: Int128_Storable -> Int128_Storable -> Int128_Storable
- :: Int128_Storable -> Int128_Storable -> Int128_Storable
$c- :: Int128_Storable -> Int128_Storable -> Int128_Storable
+ :: Int128_Storable -> Int128_Storable -> Int128_Storable
$c+ :: Int128_Storable -> Int128_Storable -> Int128_Storable
Num,ReadPrec [Int128_Storable]
ReadPrec Int128_Storable
Int -> ReadS Int128_Storable
ReadS [Int128_Storable]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Int128_Storable]
$creadListPrec :: ReadPrec [Int128_Storable]
readPrec :: ReadPrec Int128_Storable
$creadPrec :: ReadPrec Int128_Storable
readList :: ReadS [Int128_Storable]
$creadList :: ReadS [Int128_Storable]
readsPrec :: Int -> ReadS Int128_Storable
$creadsPrec :: Int -> ReadS Int128_Storable
Read,Int -> Int128_Storable -> ShowS
[Int128_Storable] -> ShowS
Int128_Storable -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Int128_Storable] -> ShowS
$cshowList :: [Int128_Storable] -> ShowS
show :: Int128_Storable -> String
$cshow :: Int128_Storable -> String
showsPrec :: Int -> Int128_Storable -> ShowS
$cshowsPrec :: Int -> Int128_Storable -> ShowS
Show,BinaryWord Int128_Storable
SignedWord (LoWord Int128_Storable) -> Int128_Storable
HiWord Int128_Storable -> LoWord Int128_Storable -> Int128_Storable
LoWord Int128_Storable -> Int128_Storable
Int128_Storable -> HiWord Int128_Storable
Int128_Storable -> LoWord Int128_Storable
forall w.
BinaryWord w
-> (w -> LoWord w)
-> (w -> HiWord w)
-> (HiWord w -> LoWord w -> w)
-> (LoWord w -> w)
-> (SignedWord (LoWord w) -> w)
-> DoubleWord w
signExtendLo :: SignedWord (LoWord Int128_Storable) -> Int128_Storable
$csignExtendLo :: SignedWord (LoWord Int128_Storable) -> Int128_Storable
extendLo :: LoWord Int128_Storable -> Int128_Storable
$cextendLo :: LoWord Int128_Storable -> Int128_Storable
fromHiAndLo :: HiWord Int128_Storable -> LoWord Int128_Storable -> Int128_Storable
$cfromHiAndLo :: HiWord Int128_Storable -> LoWord Int128_Storable -> Int128_Storable
hiWord :: Int128_Storable -> HiWord Int128_Storable
$chiWord :: Int128_Storable -> HiWord Int128_Storable
loWord :: Int128_Storable -> LoWord Int128_Storable
$cloWord :: Int128_Storable -> LoWord Int128_Storable
DoubleWord,FiniteBits (SignedWord Int128_Storable)
FiniteBits (UnsignedWord Int128_Storable)
FiniteBits Int128_Storable
Int128_Storable
Int128_Storable -> Bool
Int128_Storable -> Int
Int128_Storable -> SignedWord Int128_Storable
Int128_Storable -> UnsignedWord Int128_Storable
Int128_Storable -> Int128_Storable
Int128_Storable
-> Int128_Storable
-> (Int128_Storable, UnsignedWord Int128_Storable)
forall w.
FiniteBits w
-> FiniteBits (UnsignedWord w)
-> FiniteBits (SignedWord w)
-> (w -> UnsignedWord w)
-> (w -> SignedWord w)
-> (w -> w -> (w, UnsignedWord w))
-> (w -> w -> (w, UnsignedWord w))
-> (w -> Int)
-> (w -> Int)
-> w
-> w
-> w
-> w
-> (w -> Bool)
-> (w -> Bool)
-> (w -> w)
-> (w -> w)
-> (w -> w)
-> (w -> w)
-> BinaryWord w
clearLsb :: Int128_Storable -> Int128_Storable
$cclearLsb :: Int128_Storable -> Int128_Storable
clearMsb :: Int128_Storable -> Int128_Storable
$cclearMsb :: Int128_Storable -> Int128_Storable
setLsb :: Int128_Storable -> Int128_Storable
$csetLsb :: Int128_Storable -> Int128_Storable
setMsb :: Int128_Storable -> Int128_Storable
$csetMsb :: Int128_Storable -> Int128_Storable
testLsb :: Int128_Storable -> Bool
$ctestLsb :: Int128_Storable -> Bool
testMsb :: Int128_Storable -> Bool
$ctestMsb :: Int128_Storable -> Bool
lsb :: Int128_Storable
$clsb :: Int128_Storable
msb :: Int128_Storable
$cmsb :: Int128_Storable
allOnes :: Int128_Storable
$callOnes :: Int128_Storable
allZeroes :: Int128_Storable
$callZeroes :: Int128_Storable
trailingZeroes :: Int128_Storable -> Int
$ctrailingZeroes :: Int128_Storable -> Int
leadingZeroes :: Int128_Storable -> Int
$cleadingZeroes :: Int128_Storable -> Int
unwrappedMul :: Int128_Storable
-> Int128_Storable
-> (Int128_Storable, UnsignedWord Int128_Storable)
$cunwrappedMul :: Int128_Storable
-> Int128_Storable
-> (Int128_Storable, UnsignedWord Int128_Storable)
unwrappedAdd :: Int128_Storable
-> Int128_Storable
-> (Int128_Storable, UnsignedWord Int128_Storable)
$cunwrappedAdd :: Int128_Storable
-> Int128_Storable
-> (Int128_Storable, UnsignedWord Int128_Storable)
signedWord :: Int128_Storable -> SignedWord Int128_Storable
$csignedWord :: Int128_Storable -> SignedWord Int128_Storable
unsignedWord :: Int128_Storable -> UnsignedWord Int128_Storable
$cunsignedWord :: Int128_Storable -> UnsignedWord Int128_Storable
BinaryWord,Bits Int128_Storable
Int128_Storable -> Int
forall b.
Bits b -> (b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
countTrailingZeros :: Int128_Storable -> Int
$ccountTrailingZeros :: Int128_Storable -> Int
countLeadingZeros :: Int128_Storable -> Int
$ccountLeadingZeros :: Int128_Storable -> Int
finiteBitSize :: Int128_Storable -> Int
$cfiniteBitSize :: Int128_Storable -> Int
FiniteBits)
    via Int128
newtype Int256_Storable = Int256_Storable Int256
  deriving (Eq Int256_Storable
Int256_Storable
Int -> Int256_Storable
Int256_Storable -> Bool
Int256_Storable -> Int
Int256_Storable -> Maybe Int
Int256_Storable -> Int256_Storable
Int256_Storable -> Int -> Bool
Int256_Storable -> Int -> Int256_Storable
Int256_Storable -> Int256_Storable -> Int256_Storable
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: Int256_Storable -> Int
$cpopCount :: Int256_Storable -> Int
rotateR :: Int256_Storable -> Int -> Int256_Storable
$crotateR :: Int256_Storable -> Int -> Int256_Storable
rotateL :: Int256_Storable -> Int -> Int256_Storable
$crotateL :: Int256_Storable -> Int -> Int256_Storable
unsafeShiftR :: Int256_Storable -> Int -> Int256_Storable
$cunsafeShiftR :: Int256_Storable -> Int -> Int256_Storable
shiftR :: Int256_Storable -> Int -> Int256_Storable
$cshiftR :: Int256_Storable -> Int -> Int256_Storable
unsafeShiftL :: Int256_Storable -> Int -> Int256_Storable
$cunsafeShiftL :: Int256_Storable -> Int -> Int256_Storable
shiftL :: Int256_Storable -> Int -> Int256_Storable
$cshiftL :: Int256_Storable -> Int -> Int256_Storable
isSigned :: Int256_Storable -> Bool
$cisSigned :: Int256_Storable -> Bool
bitSize :: Int256_Storable -> Int
$cbitSize :: Int256_Storable -> Int
bitSizeMaybe :: Int256_Storable -> Maybe Int
$cbitSizeMaybe :: Int256_Storable -> Maybe Int
testBit :: Int256_Storable -> Int -> Bool
$ctestBit :: Int256_Storable -> Int -> Bool
complementBit :: Int256_Storable -> Int -> Int256_Storable
$ccomplementBit :: Int256_Storable -> Int -> Int256_Storable
clearBit :: Int256_Storable -> Int -> Int256_Storable
$cclearBit :: Int256_Storable -> Int -> Int256_Storable
setBit :: Int256_Storable -> Int -> Int256_Storable
$csetBit :: Int256_Storable -> Int -> Int256_Storable
bit :: Int -> Int256_Storable
$cbit :: Int -> Int256_Storable
zeroBits :: Int256_Storable
$czeroBits :: Int256_Storable
rotate :: Int256_Storable -> Int -> Int256_Storable
$crotate :: Int256_Storable -> Int -> Int256_Storable
shift :: Int256_Storable -> Int -> Int256_Storable
$cshift :: Int256_Storable -> Int -> Int256_Storable
complement :: Int256_Storable -> Int256_Storable
$ccomplement :: Int256_Storable -> Int256_Storable
xor :: Int256_Storable -> Int256_Storable -> Int256_Storable
$cxor :: Int256_Storable -> Int256_Storable -> Int256_Storable
.|. :: Int256_Storable -> Int256_Storable -> Int256_Storable
$c.|. :: Int256_Storable -> Int256_Storable -> Int256_Storable
.&. :: Int256_Storable -> Int256_Storable -> Int256_Storable
$c.&. :: Int256_Storable -> Int256_Storable -> Int256_Storable
Bits,Int256_Storable
forall a. a -> a -> Bounded a
maxBound :: Int256_Storable
$cmaxBound :: Int256_Storable
minBound :: Int256_Storable
$cminBound :: Int256_Storable
Bounded,Int -> Int256_Storable
Int256_Storable -> Int
Int256_Storable -> [Int256_Storable]
Int256_Storable -> Int256_Storable
Int256_Storable -> Int256_Storable -> [Int256_Storable]
Int256_Storable
-> Int256_Storable -> Int256_Storable -> [Int256_Storable]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Int256_Storable
-> Int256_Storable -> Int256_Storable -> [Int256_Storable]
$cenumFromThenTo :: Int256_Storable
-> Int256_Storable -> Int256_Storable -> [Int256_Storable]
enumFromTo :: Int256_Storable -> Int256_Storable -> [Int256_Storable]
$cenumFromTo :: Int256_Storable -> Int256_Storable -> [Int256_Storable]
enumFromThen :: Int256_Storable -> Int256_Storable -> [Int256_Storable]
$cenumFromThen :: Int256_Storable -> Int256_Storable -> [Int256_Storable]
enumFrom :: Int256_Storable -> [Int256_Storable]
$cenumFrom :: Int256_Storable -> [Int256_Storable]
fromEnum :: Int256_Storable -> Int
$cfromEnum :: Int256_Storable -> Int
toEnum :: Int -> Int256_Storable
$ctoEnum :: Int -> Int256_Storable
pred :: Int256_Storable -> Int256_Storable
$cpred :: Int256_Storable -> Int256_Storable
succ :: Int256_Storable -> Int256_Storable
$csucc :: Int256_Storable -> Int256_Storable
Enum,Num Int256_Storable
Ord Int256_Storable
Int256_Storable -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Int256_Storable -> Rational
$ctoRational :: Int256_Storable -> Rational
Real,Enum Int256_Storable
Real Int256_Storable
Int256_Storable -> Integer
Int256_Storable
-> Int256_Storable -> (Int256_Storable, Int256_Storable)
Int256_Storable -> Int256_Storable -> Int256_Storable
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Int256_Storable -> Integer
$ctoInteger :: Int256_Storable -> Integer
divMod :: Int256_Storable
-> Int256_Storable -> (Int256_Storable, Int256_Storable)
$cdivMod :: Int256_Storable
-> Int256_Storable -> (Int256_Storable, Int256_Storable)
quotRem :: Int256_Storable
-> Int256_Storable -> (Int256_Storable, Int256_Storable)
$cquotRem :: Int256_Storable
-> Int256_Storable -> (Int256_Storable, Int256_Storable)
mod :: Int256_Storable -> Int256_Storable -> Int256_Storable
$cmod :: Int256_Storable -> Int256_Storable -> Int256_Storable
div :: Int256_Storable -> Int256_Storable -> Int256_Storable
$cdiv :: Int256_Storable -> Int256_Storable -> Int256_Storable
rem :: Int256_Storable -> Int256_Storable -> Int256_Storable
$crem :: Int256_Storable -> Int256_Storable -> Int256_Storable
quot :: Int256_Storable -> Int256_Storable -> Int256_Storable
$cquot :: Int256_Storable -> Int256_Storable -> Int256_Storable
Integral,Int256_Storable -> Int256_Storable -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Int256_Storable -> Int256_Storable -> Bool
$c/= :: Int256_Storable -> Int256_Storable -> Bool
== :: Int256_Storable -> Int256_Storable -> Bool
$c== :: Int256_Storable -> Int256_Storable -> Bool
Eq,Eq Int256_Storable
Int256_Storable -> Int256_Storable -> Bool
Int256_Storable -> Int256_Storable -> Ordering
Int256_Storable -> Int256_Storable -> Int256_Storable
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
min :: Int256_Storable -> Int256_Storable -> Int256_Storable
$cmin :: Int256_Storable -> Int256_Storable -> Int256_Storable
max :: Int256_Storable -> Int256_Storable -> Int256_Storable
$cmax :: Int256_Storable -> Int256_Storable -> Int256_Storable
>= :: Int256_Storable -> Int256_Storable -> Bool
$c>= :: Int256_Storable -> Int256_Storable -> Bool
> :: Int256_Storable -> Int256_Storable -> Bool
$c> :: Int256_Storable -> Int256_Storable -> Bool
<= :: Int256_Storable -> Int256_Storable -> Bool
$c<= :: Int256_Storable -> Int256_Storable -> Bool
< :: Int256_Storable -> Int256_Storable -> Bool
$c< :: Int256_Storable -> Int256_Storable -> Bool
compare :: Int256_Storable -> Int256_Storable -> Ordering
$ccompare :: Int256_Storable -> Int256_Storable -> Ordering
Ord,Integer -> Int256_Storable
Int256_Storable -> Int256_Storable
Int256_Storable -> Int256_Storable -> Int256_Storable
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Int256_Storable
$cfromInteger :: Integer -> Int256_Storable
signum :: Int256_Storable -> Int256_Storable
$csignum :: Int256_Storable -> Int256_Storable
abs :: Int256_Storable -> Int256_Storable
$cabs :: Int256_Storable -> Int256_Storable
negate :: Int256_Storable -> Int256_Storable
$cnegate :: Int256_Storable -> Int256_Storable
* :: Int256_Storable -> Int256_Storable -> Int256_Storable
$c* :: Int256_Storable -> Int256_Storable -> Int256_Storable
- :: Int256_Storable -> Int256_Storable -> Int256_Storable
$c- :: Int256_Storable -> Int256_Storable -> Int256_Storable
+ :: Int256_Storable -> Int256_Storable -> Int256_Storable
$c+ :: Int256_Storable -> Int256_Storable -> Int256_Storable
Num,ReadPrec [Int256_Storable]
ReadPrec Int256_Storable
Int -> ReadS Int256_Storable
ReadS [Int256_Storable]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Int256_Storable]
$creadListPrec :: ReadPrec [Int256_Storable]
readPrec :: ReadPrec Int256_Storable
$creadPrec :: ReadPrec Int256_Storable
readList :: ReadS [Int256_Storable]
$creadList :: ReadS [Int256_Storable]
readsPrec :: Int -> ReadS Int256_Storable
$creadsPrec :: Int -> ReadS Int256_Storable
Read,Int -> Int256_Storable -> ShowS
[Int256_Storable] -> ShowS
Int256_Storable -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Int256_Storable] -> ShowS
$cshowList :: [Int256_Storable] -> ShowS
show :: Int256_Storable -> String
$cshow :: Int256_Storable -> String
showsPrec :: Int -> Int256_Storable -> ShowS
$cshowsPrec :: Int -> Int256_Storable -> ShowS
Show,BinaryWord Int256_Storable
SignedWord (LoWord Int256_Storable) -> Int256_Storable
HiWord Int256_Storable -> LoWord Int256_Storable -> Int256_Storable
LoWord Int256_Storable -> Int256_Storable
Int256_Storable -> HiWord Int256_Storable
Int256_Storable -> LoWord Int256_Storable
forall w.
BinaryWord w
-> (w -> LoWord w)
-> (w -> HiWord w)
-> (HiWord w -> LoWord w -> w)
-> (LoWord w -> w)
-> (SignedWord (LoWord w) -> w)
-> DoubleWord w
signExtendLo :: SignedWord (LoWord Int256_Storable) -> Int256_Storable
$csignExtendLo :: SignedWord (LoWord Int256_Storable) -> Int256_Storable
extendLo :: LoWord Int256_Storable -> Int256_Storable
$cextendLo :: LoWord Int256_Storable -> Int256_Storable
fromHiAndLo :: HiWord Int256_Storable -> LoWord Int256_Storable -> Int256_Storable
$cfromHiAndLo :: HiWord Int256_Storable -> LoWord Int256_Storable -> Int256_Storable
hiWord :: Int256_Storable -> HiWord Int256_Storable
$chiWord :: Int256_Storable -> HiWord Int256_Storable
loWord :: Int256_Storable -> LoWord Int256_Storable
$cloWord :: Int256_Storable -> LoWord Int256_Storable
DoubleWord,FiniteBits (SignedWord Int256_Storable)
FiniteBits (UnsignedWord Int256_Storable)
FiniteBits Int256_Storable
Int256_Storable
Int256_Storable -> Bool
Int256_Storable -> Int
Int256_Storable -> SignedWord Int256_Storable
Int256_Storable -> UnsignedWord Int256_Storable
Int256_Storable -> Int256_Storable
Int256_Storable
-> Int256_Storable
-> (Int256_Storable, UnsignedWord Int256_Storable)
forall w.
FiniteBits w
-> FiniteBits (UnsignedWord w)
-> FiniteBits (SignedWord w)
-> (w -> UnsignedWord w)
-> (w -> SignedWord w)
-> (w -> w -> (w, UnsignedWord w))
-> (w -> w -> (w, UnsignedWord w))
-> (w -> Int)
-> (w -> Int)
-> w
-> w
-> w
-> w
-> (w -> Bool)
-> (w -> Bool)
-> (w -> w)
-> (w -> w)
-> (w -> w)
-> (w -> w)
-> BinaryWord w
clearLsb :: Int256_Storable -> Int256_Storable
$cclearLsb :: Int256_Storable -> Int256_Storable
clearMsb :: Int256_Storable -> Int256_Storable
$cclearMsb :: Int256_Storable -> Int256_Storable
setLsb :: Int256_Storable -> Int256_Storable
$csetLsb :: Int256_Storable -> Int256_Storable
setMsb :: Int256_Storable -> Int256_Storable
$csetMsb :: Int256_Storable -> Int256_Storable
testLsb :: Int256_Storable -> Bool
$ctestLsb :: Int256_Storable -> Bool
testMsb :: Int256_Storable -> Bool
$ctestMsb :: Int256_Storable -> Bool
lsb :: Int256_Storable
$clsb :: Int256_Storable
msb :: Int256_Storable
$cmsb :: Int256_Storable
allOnes :: Int256_Storable
$callOnes :: Int256_Storable
allZeroes :: Int256_Storable
$callZeroes :: Int256_Storable
trailingZeroes :: Int256_Storable -> Int
$ctrailingZeroes :: Int256_Storable -> Int
leadingZeroes :: Int256_Storable -> Int
$cleadingZeroes :: Int256_Storable -> Int
unwrappedMul :: Int256_Storable
-> Int256_Storable
-> (Int256_Storable, UnsignedWord Int256_Storable)
$cunwrappedMul :: Int256_Storable
-> Int256_Storable
-> (Int256_Storable, UnsignedWord Int256_Storable)
unwrappedAdd :: Int256_Storable
-> Int256_Storable
-> (Int256_Storable, UnsignedWord Int256_Storable)
$cunwrappedAdd :: Int256_Storable
-> Int256_Storable
-> (Int256_Storable, UnsignedWord Int256_Storable)
signedWord :: Int256_Storable -> SignedWord Int256_Storable
$csignedWord :: Int256_Storable -> SignedWord Int256_Storable
unsignedWord :: Int256_Storable -> UnsignedWord Int256_Storable
$cunsignedWord :: Int256_Storable -> UnsignedWord Int256_Storable
BinaryWord,Bits Int256_Storable
Int256_Storable -> Int
forall b.
Bits b -> (b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
countTrailingZeros :: Int256_Storable -> Int
$ccountTrailingZeros :: Int256_Storable -> Int
countLeadingZeros :: Int256_Storable -> Int
$ccountLeadingZeros :: Int256_Storable -> Int
finiteBitSize :: Int256_Storable -> Int
$cfiniteBitSize :: Int256_Storable -> Int
FiniteBits)
    via Int256
newtype Word128_Storable = Word128_Storable Word128
  deriving (Eq Word128_Storable
Word128_Storable
Int -> Word128_Storable
Word128_Storable -> Bool
Word128_Storable -> Int
Word128_Storable -> Maybe Int
Word128_Storable -> Word128_Storable
Word128_Storable -> Int -> Bool
Word128_Storable -> Int -> Word128_Storable
Word128_Storable -> Word128_Storable -> Word128_Storable
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: Word128_Storable -> Int
$cpopCount :: Word128_Storable -> Int
rotateR :: Word128_Storable -> Int -> Word128_Storable
$crotateR :: Word128_Storable -> Int -> Word128_Storable
rotateL :: Word128_Storable -> Int -> Word128_Storable
$crotateL :: Word128_Storable -> Int -> Word128_Storable
unsafeShiftR :: Word128_Storable -> Int -> Word128_Storable
$cunsafeShiftR :: Word128_Storable -> Int -> Word128_Storable
shiftR :: Word128_Storable -> Int -> Word128_Storable
$cshiftR :: Word128_Storable -> Int -> Word128_Storable
unsafeShiftL :: Word128_Storable -> Int -> Word128_Storable
$cunsafeShiftL :: Word128_Storable -> Int -> Word128_Storable
shiftL :: Word128_Storable -> Int -> Word128_Storable
$cshiftL :: Word128_Storable -> Int -> Word128_Storable
isSigned :: Word128_Storable -> Bool
$cisSigned :: Word128_Storable -> Bool
bitSize :: Word128_Storable -> Int
$cbitSize :: Word128_Storable -> Int
bitSizeMaybe :: Word128_Storable -> Maybe Int
$cbitSizeMaybe :: Word128_Storable -> Maybe Int
testBit :: Word128_Storable -> Int -> Bool
$ctestBit :: Word128_Storable -> Int -> Bool
complementBit :: Word128_Storable -> Int -> Word128_Storable
$ccomplementBit :: Word128_Storable -> Int -> Word128_Storable
clearBit :: Word128_Storable -> Int -> Word128_Storable
$cclearBit :: Word128_Storable -> Int -> Word128_Storable
setBit :: Word128_Storable -> Int -> Word128_Storable
$csetBit :: Word128_Storable -> Int -> Word128_Storable
bit :: Int -> Word128_Storable
$cbit :: Int -> Word128_Storable
zeroBits :: Word128_Storable
$czeroBits :: Word128_Storable
rotate :: Word128_Storable -> Int -> Word128_Storable
$crotate :: Word128_Storable -> Int -> Word128_Storable
shift :: Word128_Storable -> Int -> Word128_Storable
$cshift :: Word128_Storable -> Int -> Word128_Storable
complement :: Word128_Storable -> Word128_Storable
$ccomplement :: Word128_Storable -> Word128_Storable
xor :: Word128_Storable -> Word128_Storable -> Word128_Storable
$cxor :: Word128_Storable -> Word128_Storable -> Word128_Storable
.|. :: Word128_Storable -> Word128_Storable -> Word128_Storable
$c.|. :: Word128_Storable -> Word128_Storable -> Word128_Storable
.&. :: Word128_Storable -> Word128_Storable -> Word128_Storable
$c.&. :: Word128_Storable -> Word128_Storable -> Word128_Storable
Bits,Word128_Storable
forall a. a -> a -> Bounded a
maxBound :: Word128_Storable
$cmaxBound :: Word128_Storable
minBound :: Word128_Storable
$cminBound :: Word128_Storable
Bounded,Int -> Word128_Storable
Word128_Storable -> Int
Word128_Storable -> [Word128_Storable]
Word128_Storable -> Word128_Storable
Word128_Storable -> Word128_Storable -> [Word128_Storable]
Word128_Storable
-> Word128_Storable -> Word128_Storable -> [Word128_Storable]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Word128_Storable
-> Word128_Storable -> Word128_Storable -> [Word128_Storable]
$cenumFromThenTo :: Word128_Storable
-> Word128_Storable -> Word128_Storable -> [Word128_Storable]
enumFromTo :: Word128_Storable -> Word128_Storable -> [Word128_Storable]
$cenumFromTo :: Word128_Storable -> Word128_Storable -> [Word128_Storable]
enumFromThen :: Word128_Storable -> Word128_Storable -> [Word128_Storable]
$cenumFromThen :: Word128_Storable -> Word128_Storable -> [Word128_Storable]
enumFrom :: Word128_Storable -> [Word128_Storable]
$cenumFrom :: Word128_Storable -> [Word128_Storable]
fromEnum :: Word128_Storable -> Int
$cfromEnum :: Word128_Storable -> Int
toEnum :: Int -> Word128_Storable
$ctoEnum :: Int -> Word128_Storable
pred :: Word128_Storable -> Word128_Storable
$cpred :: Word128_Storable -> Word128_Storable
succ :: Word128_Storable -> Word128_Storable
$csucc :: Word128_Storable -> Word128_Storable
Enum,Num Word128_Storable
Ord Word128_Storable
Word128_Storable -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Word128_Storable -> Rational
$ctoRational :: Word128_Storable -> Rational
Real,Enum Word128_Storable
Real Word128_Storable
Word128_Storable -> Integer
Word128_Storable
-> Word128_Storable -> (Word128_Storable, Word128_Storable)
Word128_Storable -> Word128_Storable -> Word128_Storable
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Word128_Storable -> Integer
$ctoInteger :: Word128_Storable -> Integer
divMod :: Word128_Storable
-> Word128_Storable -> (Word128_Storable, Word128_Storable)
$cdivMod :: Word128_Storable
-> Word128_Storable -> (Word128_Storable, Word128_Storable)
quotRem :: Word128_Storable
-> Word128_Storable -> (Word128_Storable, Word128_Storable)
$cquotRem :: Word128_Storable
-> Word128_Storable -> (Word128_Storable, Word128_Storable)
mod :: Word128_Storable -> Word128_Storable -> Word128_Storable
$cmod :: Word128_Storable -> Word128_Storable -> Word128_Storable
div :: Word128_Storable -> Word128_Storable -> Word128_Storable
$cdiv :: Word128_Storable -> Word128_Storable -> Word128_Storable
rem :: Word128_Storable -> Word128_Storable -> Word128_Storable
$crem :: Word128_Storable -> Word128_Storable -> Word128_Storable
quot :: Word128_Storable -> Word128_Storable -> Word128_Storable
$cquot :: Word128_Storable -> Word128_Storable -> Word128_Storable
Integral,Word128_Storable -> Word128_Storable -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Word128_Storable -> Word128_Storable -> Bool
$c/= :: Word128_Storable -> Word128_Storable -> Bool
== :: Word128_Storable -> Word128_Storable -> Bool
$c== :: Word128_Storable -> Word128_Storable -> Bool
Eq,Eq Word128_Storable
Word128_Storable -> Word128_Storable -> Bool
Word128_Storable -> Word128_Storable -> Ordering
Word128_Storable -> Word128_Storable -> Word128_Storable
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
min :: Word128_Storable -> Word128_Storable -> Word128_Storable
$cmin :: Word128_Storable -> Word128_Storable -> Word128_Storable
max :: Word128_Storable -> Word128_Storable -> Word128_Storable
$cmax :: Word128_Storable -> Word128_Storable -> Word128_Storable
>= :: Word128_Storable -> Word128_Storable -> Bool
$c>= :: Word128_Storable -> Word128_Storable -> Bool
> :: Word128_Storable -> Word128_Storable -> Bool
$c> :: Word128_Storable -> Word128_Storable -> Bool
<= :: Word128_Storable -> Word128_Storable -> Bool
$c<= :: Word128_Storable -> Word128_Storable -> Bool
< :: Word128_Storable -> Word128_Storable -> Bool
$c< :: Word128_Storable -> Word128_Storable -> Bool
compare :: Word128_Storable -> Word128_Storable -> Ordering
$ccompare :: Word128_Storable -> Word128_Storable -> Ordering
Ord,Integer -> Word128_Storable
Word128_Storable -> Word128_Storable
Word128_Storable -> Word128_Storable -> Word128_Storable
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Word128_Storable
$cfromInteger :: Integer -> Word128_Storable
signum :: Word128_Storable -> Word128_Storable
$csignum :: Word128_Storable -> Word128_Storable
abs :: Word128_Storable -> Word128_Storable
$cabs :: Word128_Storable -> Word128_Storable
negate :: Word128_Storable -> Word128_Storable
$cnegate :: Word128_Storable -> Word128_Storable
* :: Word128_Storable -> Word128_Storable -> Word128_Storable
$c* :: Word128_Storable -> Word128_Storable -> Word128_Storable
- :: Word128_Storable -> Word128_Storable -> Word128_Storable
$c- :: Word128_Storable -> Word128_Storable -> Word128_Storable
+ :: Word128_Storable -> Word128_Storable -> Word128_Storable
$c+ :: Word128_Storable -> Word128_Storable -> Word128_Storable
Num,ReadPrec [Word128_Storable]
ReadPrec Word128_Storable
Int -> ReadS Word128_Storable
ReadS [Word128_Storable]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Word128_Storable]
$creadListPrec :: ReadPrec [Word128_Storable]
readPrec :: ReadPrec Word128_Storable
$creadPrec :: ReadPrec Word128_Storable
readList :: ReadS [Word128_Storable]
$creadList :: ReadS [Word128_Storable]
readsPrec :: Int -> ReadS Word128_Storable
$creadsPrec :: Int -> ReadS Word128_Storable
Read,Int -> Word128_Storable -> ShowS
[Word128_Storable] -> ShowS
Word128_Storable -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Word128_Storable] -> ShowS
$cshowList :: [Word128_Storable] -> ShowS
show :: Word128_Storable -> String
$cshow :: Word128_Storable -> String
showsPrec :: Int -> Word128_Storable -> ShowS
$cshowsPrec :: Int -> Word128_Storable -> ShowS
Show,BinaryWord Word128_Storable
SignedWord (LoWord Word128_Storable) -> Word128_Storable
HiWord Word128_Storable
-> LoWord Word128_Storable -> Word128_Storable
LoWord Word128_Storable -> Word128_Storable
Word128_Storable -> HiWord Word128_Storable
Word128_Storable -> LoWord Word128_Storable
forall w.
BinaryWord w
-> (w -> LoWord w)
-> (w -> HiWord w)
-> (HiWord w -> LoWord w -> w)
-> (LoWord w -> w)
-> (SignedWord (LoWord w) -> w)
-> DoubleWord w
signExtendLo :: SignedWord (LoWord Word128_Storable) -> Word128_Storable
$csignExtendLo :: SignedWord (LoWord Word128_Storable) -> Word128_Storable
extendLo :: LoWord Word128_Storable -> Word128_Storable
$cextendLo :: LoWord Word128_Storable -> Word128_Storable
fromHiAndLo :: HiWord Word128_Storable
-> LoWord Word128_Storable -> Word128_Storable
$cfromHiAndLo :: HiWord Word128_Storable
-> LoWord Word128_Storable -> Word128_Storable
hiWord :: Word128_Storable -> HiWord Word128_Storable
$chiWord :: Word128_Storable -> HiWord Word128_Storable
loWord :: Word128_Storable -> LoWord Word128_Storable
$cloWord :: Word128_Storable -> LoWord Word128_Storable
DoubleWord,FiniteBits (SignedWord Word128_Storable)
FiniteBits (UnsignedWord Word128_Storable)
FiniteBits Word128_Storable
Word128_Storable
Word128_Storable -> Bool
Word128_Storable -> Int
Word128_Storable -> SignedWord Word128_Storable
Word128_Storable -> UnsignedWord Word128_Storable
Word128_Storable -> Word128_Storable
Word128_Storable
-> Word128_Storable
-> (Word128_Storable, UnsignedWord Word128_Storable)
forall w.
FiniteBits w
-> FiniteBits (UnsignedWord w)
-> FiniteBits (SignedWord w)
-> (w -> UnsignedWord w)
-> (w -> SignedWord w)
-> (w -> w -> (w, UnsignedWord w))
-> (w -> w -> (w, UnsignedWord w))
-> (w -> Int)
-> (w -> Int)
-> w
-> w
-> w
-> w
-> (w -> Bool)
-> (w -> Bool)
-> (w -> w)
-> (w -> w)
-> (w -> w)
-> (w -> w)
-> BinaryWord w
clearLsb :: Word128_Storable -> Word128_Storable
$cclearLsb :: Word128_Storable -> Word128_Storable
clearMsb :: Word128_Storable -> Word128_Storable
$cclearMsb :: Word128_Storable -> Word128_Storable
setLsb :: Word128_Storable -> Word128_Storable
$csetLsb :: Word128_Storable -> Word128_Storable
setMsb :: Word128_Storable -> Word128_Storable
$csetMsb :: Word128_Storable -> Word128_Storable
testLsb :: Word128_Storable -> Bool
$ctestLsb :: Word128_Storable -> Bool
testMsb :: Word128_Storable -> Bool
$ctestMsb :: Word128_Storable -> Bool
lsb :: Word128_Storable
$clsb :: Word128_Storable
msb :: Word128_Storable
$cmsb :: Word128_Storable
allOnes :: Word128_Storable
$callOnes :: Word128_Storable
allZeroes :: Word128_Storable
$callZeroes :: Word128_Storable
trailingZeroes :: Word128_Storable -> Int
$ctrailingZeroes :: Word128_Storable -> Int
leadingZeroes :: Word128_Storable -> Int
$cleadingZeroes :: Word128_Storable -> Int
unwrappedMul :: Word128_Storable
-> Word128_Storable
-> (Word128_Storable, UnsignedWord Word128_Storable)
$cunwrappedMul :: Word128_Storable
-> Word128_Storable
-> (Word128_Storable, UnsignedWord Word128_Storable)
unwrappedAdd :: Word128_Storable
-> Word128_Storable
-> (Word128_Storable, UnsignedWord Word128_Storable)
$cunwrappedAdd :: Word128_Storable
-> Word128_Storable
-> (Word128_Storable, UnsignedWord Word128_Storable)
signedWord :: Word128_Storable -> SignedWord Word128_Storable
$csignedWord :: Word128_Storable -> SignedWord Word128_Storable
unsignedWord :: Word128_Storable -> UnsignedWord Word128_Storable
$cunsignedWord :: Word128_Storable -> UnsignedWord Word128_Storable
BinaryWord,Bits Word128_Storable
Word128_Storable -> Int
forall b.
Bits b -> (b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
countTrailingZeros :: Word128_Storable -> Int
$ccountTrailingZeros :: Word128_Storable -> Int
countLeadingZeros :: Word128_Storable -> Int
$ccountLeadingZeros :: Word128_Storable -> Int
finiteBitSize :: Word128_Storable -> Int
$cfiniteBitSize :: Word128_Storable -> Int
FiniteBits)
    via Word128
#endif


-- | Type Max of Kind ES
type family Max (es :: ES)
  where
    Max Z_3_2    = V_3_2
    Max I_3_2    = V_3_2
    Max II_3_2   = V_3_2
    Max III_3_2  = V_3_2
    Max IV_3_2   = V_3_2
    Max V_3_2    = V_3_2
    Max Z_2022   = V_2022
    Max I_2022   = V_2022
    Max II_2022  = V_2022
    Max III_2022 = V_2022
    Max IV_2022  = V_2022
    Max V_2022   = V_2022

type family Next (es :: ES)
  where
    Next Z_3_2    = I_3_2
    Next I_3_2    = II_3_2
    Next II_3_2   = III_3_2
    Next III_3_2  = IV_3_2
    Next IV_3_2   = V_3_2
    Next V_3_2    = V_3_2
    Next Z_2022   = I_2022
    Next I_2022   = II_2022
    Next II_2022  = III_2022
    Next III_2022 = IV_2022
    Next IV_2022  = V_2022
    Next V_2022   = V_2022

-- | The 'FixedWidthInteger' is a Constraint Synonym that contains all
-- of the constraints provided by the 'IntN' Type Family.  It is a super
-- class for the Posit Class.
type FixedWidthInteger a = 
  (Bits a
  ,Bounded a
  ,Enum a
  ,Integral a
  ,Eq a
  ,Ord a
  ,Num a
  ,Read a
  ,Show a
#ifndef O_NO_STORABLE
  ,Storable a
#endif
  )


-- | The 'Posit' class is an approximation of ℝ, it is like a sampling 
-- on the Projective Real line ℙ(ℝ) with Maybe ℚ as the internal type.
-- The 'es' is an index that controlls the log2 word size of the Posit's
-- fininte precision representation.
class (FixedWidthInteger (IntN es)) => PositC (es :: ES) where
  
  -- | Transform to/from the Infinite Precision Representation
  encode :: Maybe Rational -> IntN es  -- ^ Maybe you have some Rational Number and you want to encode it as some integer with a finite integer log2 word size.
  encode Maybe Rational
Nothing = forall (es :: ES). PositC es => IntN es
unReal @es
  encode (Just Rational
0) = IntN es
0
  encode (Just Rational
r)
    | Rational
r forall a. Ord a => a -> a -> Bool
> forall (es :: ES). PositC es => Rational
maxPosRat @es = forall (es :: ES). PositC es => IntN es
mostPosVal @es
    | Rational
r forall a. Ord a => a -> a -> Bool
< forall (es :: ES). PositC es => Rational
minNegRat @es = forall (es :: ES). PositC es => IntN es
mostNegVal @es
    | Rational
r forall a. Ord a => a -> a -> Bool
> Rational
0 Bool -> Bool -> Bool
&& Rational
r forall a. Ord a => a -> a -> Bool
< forall (es :: ES). PositC es => Rational
minPosRat @es = forall (es :: ES). PositC es => IntN es
leastPosVal @es
    | Rational
r forall a. Ord a => a -> a -> Bool
< Rational
0 Bool -> Bool -> Bool
&& Rational
r forall a. Ord a => a -> a -> Bool
> forall (es :: ES). PositC es => Rational
maxNegRat @es = forall (es :: ES). PositC es => IntN es
leastNegVal @es
    | Bool
otherwise = forall (es :: ES). PositC es => Rational -> IntN es
buildIntRep @es Rational
r
  
  decode :: IntN es -> Maybe Rational  -- ^ You have an integer with a finite integer log2 word size decode it and Maybe it is Rational
  decode IntN es
int
    | IntN es
int forall a. Eq a => a -> a -> Bool
== forall (es :: ES). PositC es => IntN es
unReal @es = forall a. Maybe a
Nothing
    | IntN es
int forall a. Eq a => a -> a -> Bool
== IntN es
0 = forall a. a -> Maybe a
Just Rational
0
    | Bool
otherwise =
      let sgn :: Bool
sgn = IntN es
int forall a. Ord a => a -> a -> Bool
< IntN es
0
          int' :: IntN es
int' = if Bool
sgn
                 then forall a. Num a => a -> a
negate IntN es
int
                 else IntN es
int
          (Integer
regime,Int
nR) = forall (es :: ES). PositC es => IntN es -> (Integer, Int)
regime2Integer @es IntN es
int'
          exponent :: Natural
exponent = forall (es :: ES). PositC es => Int -> IntN es -> Natural
exponent2Nat @es Int
nR IntN es
int'  -- if no e or some bits missing, then they are considered zero
          rat :: Rational
rat = forall (es :: ES). PositC es => Int -> IntN es -> Rational
fraction2Posit @es Int
nR IntN es
int'  -- if no fraction or some bits missing, then the missing bits are zero, making the significand p=1
      in forall (es :: ES).
PositC es =>
(Bool, Integer, Natural, Rational) -> Maybe Rational
tupPosit2Posit @es (Bool
sgn,Integer
regime,Natural
exponent,Rational
rat)
  
  
  -- | Exponent Size based on the Posit Exponent kind ES, Posit-2022 sets the default to 2.
  exponentSize :: Natural  -- ^ The exponent size, 'es' is a Natural number
  exponentSize = Natural
2
  
  -- | Various other size definitions used in the Posit format with their default definitions
  nBytes :: Natural  -- ^ 'nBytes' the number of bytes of the Posit Representation
  nBytes = Natural
2forall a b. (Num a, Integral b) => a -> b -> a
^(forall (es :: ES). PositC es => Natural
exponentSize @es)
  
  nBits :: Natural  -- ^ 'nBits' the number of bits of the Posit Representation
  nBits = Natural
8 forall a. Num a => a -> a -> a
* (forall (es :: ES). PositC es => Natural
nBytes @es)
  
  signBitSize :: Natural  -- ^ 'signBitSize' the size of the sign bit
  signBitSize = Natural
1
  
  uSeed :: Natural  -- ^ 'uSeed' scaling factor for the regime of the Posit Representation
  uSeed = Natural
2forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2forall a b. (Num a, Integral b) => a -> b -> a
^(forall (es :: ES). PositC es => Natural
exponentSize @es)
  
  -- | Integer Representation of common bounds
  unReal :: IntN es  -- ^ 'unReal' is something that is not Real, the integer value that is not a Real number
  unReal = forall a. Bounded a => a
minBound @(IntN es)
  
  mostPosVal :: IntN es
  mostPosVal = forall a. Bounded a => a
maxBound @(IntN es)
  
  leastPosVal :: IntN es
  leastPosVal = IntN es
1
  
  leastNegVal :: IntN es
  leastNegVal = -IntN es
1
  
  mostNegVal :: IntN es
  mostNegVal = forall a. Num a => a -> a
negate (forall (es :: ES). PositC es => IntN es
mostPosVal @es)
  
  -- Rational Value of common bounds
  maxPosRat :: Rational
  maxPosRat = (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (es :: ES). PositC es => Natural
uSeed @es)forall a b. (Num a, Integral b) => a -> b -> a
^(forall (es :: ES). PositC es => Natural
nBits @es forall a. Num a => a -> a -> a
- Natural
2)) forall a. Integral a => a -> a -> Ratio a
% Integer
1
  minPosRat :: Rational
  minPosRat = forall a. Fractional a => a -> a
recip (forall (es :: ES). PositC es => Rational
maxPosRat @es)
  maxNegRat :: Rational
  maxNegRat = forall a. Num a => a -> a
negate (forall (es :: ES). PositC es => Rational
minPosRat @es)
  minNegRat :: Rational
  minNegRat = forall a. Num a => a -> a
negate (forall (es :: ES). PositC es => Rational
maxPosRat @es)
  
  -- Functions to support encode and decode
  
  -- log base uSeed
  -- After calculating the regime the rational should be in the range [1,uSeed), it starts with (0,rational)
  log_uSeed :: (Integer, Rational) -> (Integer, Rational)
  log_uSeed (Integer
regime,Rational
r)
    | Rational
r forall a. Ord a => a -> a -> Bool
< Rational
1 = forall (es :: ES).
PositC es =>
(Integer, Rational) -> (Integer, Rational)
log_uSeed @es (Integer
regimeforall a. Num a => a -> a -> a
-Integer
1,Rational
r forall a. Num a => a -> a -> a
* forall a. Fractional a => Rational -> a
fromRational (forall a. Integral a => a -> Integer
toInteger (forall (es :: ES). PositC es => Natural
uSeed @es) forall a. Integral a => a -> a -> Ratio a
% Integer
1))
    | Rational
r forall a. Ord a => a -> a -> Bool
>= forall a. Fractional a => Rational -> a
fromRational (forall a. Integral a => a -> Integer
toInteger (forall (es :: ES). PositC es => Natural
uSeed @es) forall a. Integral a => a -> a -> Ratio a
% Integer
1) = forall (es :: ES).
PositC es =>
(Integer, Rational) -> (Integer, Rational)
log_uSeed @es (Integer
regimeforall a. Num a => a -> a -> a
+Integer
1,Rational
r forall a. Num a => a -> a -> a
* forall a. Fractional a => Rational -> a
fromRational (Integer
1 forall a. Integral a => a -> a -> Ratio a
% forall a. Integral a => a -> Integer
toInteger (forall (es :: ES). PositC es => Natural
uSeed @es)))
    | Bool
otherwise = (Integer
regime,Rational
r)
  
  getRegime :: Rational -> (Integer, Rational)
  getRegime Rational
r = forall (es :: ES).
PositC es =>
(Integer, Rational) -> (Integer, Rational)
log_uSeed @es (Integer
0,Rational
r)
  
  posit2TupPosit :: Rational -> (Bool, Integer, Natural, Rational)
  posit2TupPosit Rational
r =
    let (Bool
sgn,Rational
r') = Rational -> (Bool, Rational)
getSign Rational
r -- returns the sign and a positive rational
        (Integer
regime,Rational
r'') = forall (es :: ES). PositC es => Rational -> (Integer, Rational)
getRegime @es Rational
r' -- returns the regime and a rational between uSeed^-1 to uSeed^1
        (Natural
exponent,Rational
significand) = Rational -> (Natural, Rational)
getExponent Rational
r'' -- returns the exponent and a rational between [1,2), the significand
    in (Bool
sgn,Integer
regime,Natural
exponent,Rational
significand)
  
  buildIntRep :: Rational -> IntN es
  buildIntRep Rational
r =
    let (Bool
signBit,Integer
regime,Natural
exponent,Rational
significand) = forall (es :: ES).
PositC es =>
Rational -> (Bool, Integer, Natural, Rational)
posit2TupPosit @es Rational
r
        intRep :: IntN es
intRep = forall (es :: ES).
PositC es =>
Integer -> Natural -> Rational -> IntN es
mkIntRep @es Integer
regime Natural
exponent Rational
significand
    in if Bool
signBit
       then forall a. Num a => a -> a
negate IntN es
intRep
       else IntN es
intRep
  
  mkIntRep :: Integer -> Natural -> Rational -> IntN es
  mkIntRep Integer
regime Natural
exponent Rational
significand =
    let (IntN es
regime', Integer
offset) = forall (es :: ES). PositC es => Integer -> (IntN es, Integer)
formRegime @es Integer
regime  -- offset is the number of binary digits remaining after the regime is formed
        (IntN es
exponent', Integer
offset') = forall (es :: ES).
PositC es =>
Natural -> Integer -> (IntN es, Integer)
formExponent @es Natural
exponent Integer
offset  -- offset' is the number of binary digits remaining after the exponent is formed
        fraction :: IntN es
fraction = forall (es :: ES). PositC es => Rational -> Integer -> IntN es
formFraction @es Rational
significand Integer
offset'
    in IntN es
regime' forall a. Num a => a -> a -> a
+ IntN es
exponent' forall a. Num a => a -> a -> a
+ IntN es
fraction  --  Previously bad code...
    -- Was previously Bitwise OR'd (regime' .|. exponent' .|. fraction), but that failed when an overflow occurs in the fraction:
    -- (R @V_3_2 (6546781215792283740026379393655198304433284092086129578966582736192267592809066457889108741457440782093636999212155773298525238592782299216095867171579 % 6546781215792283740026379393655198304433284092086129578966582736192267592809349109766540184651808314301773368255120142018434513091770786106657055178752))
  
  formRegime :: Integer -> (IntN es, Integer)
  formRegime Integer
power
    | Integer
0 forall a. Ord a => a -> a -> Bool
<= Integer
power =
      let offset :: Integer
offset = (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (es :: ES). PositC es => Natural
nBits @es forall a. Num a => a -> a -> a
- Natural
1) forall a. Num a => a -> a -> a
-     Integer
power forall a. Num a => a -> a -> a
- Integer
1)
      in (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
2forall a b. (Num a, Integral b) => a -> b -> a
^(Integer
power forall a. Num a => a -> a -> a
+ Integer
1) forall a. Num a => a -> a -> a
- Integer
1) forall a. Bits a => a -> Int -> a
`shiftL` forall a. Num a => Integer -> a
fromInteger Integer
offset, Integer
offset forall a. Num a => a -> a -> a
- Integer
1)
    | Bool
otherwise =
      let offset :: Integer
offset = (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (es :: ES). PositC es => Natural
nBits @es forall a. Num a => a -> a -> a
- Natural
1) forall a. Num a => a -> a -> a
- forall a. Num a => a -> a
abs Integer
power forall a. Num a => a -> a -> a
- Integer
1)
      in (IntN es
1 forall a. Bits a => a -> Int -> a
`shiftL` forall a. Num a => Integer -> a
fromInteger Integer
offset, Integer
offset)
  
  formExponent :: Natural -> Integer -> (IntN es, Integer)
  formExponent Natural
power Integer
offset =
    let offset' :: Integer
offset' = Integer
offset forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (es :: ES). PositC es => Natural
exponentSize @es)
    in (forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
power forall a. Bits a => a -> Int -> a
`shift` forall a. Num a => Integer -> a
fromInteger Integer
offset', Integer
offset')
  
  formFraction :: Rational -> Integer -> IntN es
  formFraction Rational
r Integer
offset =
    let numFractionBits :: Integer
numFractionBits = Integer
offset
        fractionSize :: Rational
fractionSize = Rational
2forall a b. (Num a, Integral b) => a -> b -> a
^Integer
numFractionBits
        normFraction :: Integer
normFraction = forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ (Rational
r forall a. Num a => a -> a -> a
- Rational
1) forall a. Num a => a -> a -> a
* Rational
fractionSize  -- "posit - 1" is changing it from the significand to the fraction: [1,2) -> [0,1)
    in if Integer
numFractionBits forall a. Ord a => a -> a -> Bool
>= Integer
1
       then forall a. Num a => Integer -> a
fromInteger Integer
normFraction
       else IntN es
0
  
  tupPosit2Posit :: (Bool,Integer,Natural,Rational) -> Maybe Rational
  tupPosit2Posit (Bool
sgn,Integer
regime,Natural
exponent,Rational
rat) = -- s = isNeg posit == True
    let pow2 :: Rational
pow2 = forall a. Real a => a -> Rational
toRational (forall (es :: ES). PositC es => Natural
uSeed @es)forall a b. (Fractional a, Integral b) => a -> b -> a
^^Integer
regime forall a. Num a => a -> a -> a
* Rational
2forall a b. (Num a, Integral b) => a -> b -> a
^Natural
exponent
        scale :: Rational
scale = if Bool
sgn
                then forall a. Num a => a -> a
negate Rational
pow2
                else Rational
pow2
    in forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Rational
scale forall a. Num a => a -> a -> a
* Rational
rat
  
  regime2Integer :: IntN es -> (Integer, Int)
  regime2Integer IntN es
posit =
    let regimeFormat :: Bool
regimeFormat = forall (es :: ES). PositC es => IntN es -> Bool
findRegimeFormat @es IntN es
posit
        regimeCount :: Int
regimeCount = forall (es :: ES). PositC es => Bool -> IntN es -> Int
countRegimeBits @es Bool
regimeFormat IntN es
posit
        regime :: Integer
regime = Bool -> Int -> Integer
calcRegimeInt Bool
regimeFormat Int
regimeCount
    in (Integer
regime, Int
regimeCount forall a. Num a => a -> a -> a
+ Int
1) -- a rational representation of the regime and the regimeCount plus rBar which is the numBitsRegime
  
  -- will return the format of the regime, either HI or LO; it could get refactored in the future
  -- True means a 1 is the first bit in the regime
  findRegimeFormat :: IntN es -> Bool
  findRegimeFormat IntN es
posit = forall a. Bits a => a -> Int -> Bool
testBit IntN es
posit (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (es :: ES). PositC es => Natural
nBits @es) forall a. Num a => a -> a -> a
- Int
1 forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (es :: ES). PositC es => Natural
signBitSize @es))
  
  countRegimeBits :: Bool -> IntN es -> Int
  countRegimeBits Bool
format IntN es
posit = Int -> Int -> Int
go (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (es :: ES). PositC es => Natural
nBits @es) forall a. Num a => a -> a -> a
- Int
1 forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (es :: ES). PositC es => Natural
signBitSize @es)) Int
0
    where
      go :: Int -> Int -> Int
go (-1) Int
acc = Int
acc
      go Int
index Int
acc
        | Bool -> Bool -> Bool
xnor Bool
format (forall a. Bits a => a -> Int -> Bool
testBit IntN es
posit Int
index)  = Int -> Int -> Int
go (Int
index forall a. Num a => a -> a -> a
- Int
1) (Int
acc forall a. Num a => a -> a -> a
+ Int
1)
        | Bool
otherwise = Int
acc
  
  -- knowing the number of the regime bits, and the sign bit we can extract
  -- the exponent.  We mask to the left of the exponent to remove the sign and regime, and
  -- then shift to the right to remove the fraction.
  exponent2Nat :: Int -> IntN es -> Natural
  exponent2Nat Int
numBitsRegime IntN es
posit =
    let bitsRemaining :: Int
bitsRemaining = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (es :: ES). PositC es => Natural
nBits @es) forall a. Num a => a -> a -> a
- Int
numBitsRegime forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (es :: ES). PositC es => Natural
signBitSize @es)
        signNRegimeMask :: IntN es
signNRegimeMask = IntN es
2forall a b. (Num a, Integral b) => a -> b -> a
^Int
bitsRemaining forall a. Num a => a -> a -> a
- IntN es
1
        int :: IntN es
int = IntN es
posit forall a. Bits a => a -> a -> a
.&. IntN es
signNRegimeMask
        nBitsToTheRight :: Int
nBitsToTheRight = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (es :: ES). PositC es => Natural
nBits @es) forall a. Num a => a -> a -> a
- Int
numBitsRegime forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (es :: ES). PositC es => Natural
signBitSize @es) forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (es :: ES). PositC es => Natural
exponentSize @es)
    in if Int
bitsRemaining forall a. Ord a => a -> a -> Bool
<=Int
0
       then Natural
0
       else if Int
nBitsToTheRight forall a. Ord a => a -> a -> Bool
< Int
0
            then forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ IntN es
int forall a. Bits a => a -> Int -> a
`shiftL` forall a. Num a => a -> a
negate Int
nBitsToTheRight
            else forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ IntN es
int forall a. Bits a => a -> Int -> a
`shiftR` Int
nBitsToTheRight
  
  -- knowing the number of the regime bits, sign bit, and the number of the
  -- exponent bits we can extract the fraction.  We mask to the left of the fraction to
  -- remove the sign, regime, and exponent. If there is no fraction then the value is 1.
  fraction2Posit :: Int -> IntN es -> Rational
  fraction2Posit Int
numBitsRegime IntN es
posit =
    let offset :: Integer
offset = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (forall (es :: ES). PositC es => Natural
signBitSize @es) forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numBitsRegime forall a. Num a => a -> a -> a
+ (forall (es :: ES). PositC es => Natural
exponentSize @es)
        fractionSize :: Integer
fractionSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (es :: ES). PositC es => Natural
nBits @es) forall a. Num a => a -> a -> a
- Integer
offset
        fractionBits :: IntN es
fractionBits = IntN es
posit forall a. Bits a => a -> a -> a
.&. (IntN es
2forall a b. (Num a, Integral b) => a -> b -> a
^Integer
fractionSize forall a. Num a => a -> a -> a
- IntN es
1)
    in if Integer
fractionSize forall a. Ord a => a -> a -> Bool
>= Integer
1
       then (Integer
2forall a b. (Num a, Integral b) => a -> b -> a
^Integer
fractionSize forall a. Num a => a -> a -> a
+ forall a. Integral a => a -> Integer
toInteger IntN es
fractionBits) forall a. Integral a => a -> a -> Ratio a
% Integer
2forall a b. (Num a, Integral b) => a -> b -> a
^Integer
fractionSize
       else Integer
1 forall a. Integral a => a -> a -> Ratio a
% Integer
1
  
  -- prints out the IntN es value in 0b... format
  displayBin :: IntN es -> String
  displayBin IntN es
int = String
"0b" forall a. [a] -> [a] -> [a]
++ Int -> String
go (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (es :: ES). PositC es => Natural
nBits @es) forall a. Num a => a -> a -> a
- Int
1)
    where
      go :: Int -> String
      go :: Int -> String
go Int
0 = if forall a. Bits a => a -> Int -> Bool
testBit IntN es
int Int
0
             then String
"1"
             else String
"0"
      go Int
idx = if forall a. Bits a => a -> Int -> Bool
testBit IntN es
int Int
idx
               then String
"1" forall a. [a] -> [a] -> [a]
++ Int -> String
go (Int
idx forall a. Num a => a -> a -> a
- Int
1)
               else String
"0" forall a. [a] -> [a] -> [a]
++ Int -> String
go (Int
idx forall a. Num a => a -> a -> a
- Int
1)
  
  -- decimal Precision
  decimalPrec :: Int
  decimalPrec = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Natural
2 forall a. Num a => a -> a -> a
* (forall (es :: ES). PositC es => Natural
nBytes @es) forall a. Num a => a -> a -> a
+ Natural
1
  
  {-# MINIMAL exponentSize | nBytes #-}


-- =====================================================================
-- ===                    PositC Instances                           ===
-- =====================================================================
-- | Standard 3.2
instance PositC Z_3_2 where
  exponentSize :: Natural
exponentSize = Natural
0

instance PositC I_3_2 where
  exponentSize :: Natural
exponentSize = Natural
1

instance PositC II_3_2 where
  exponentSize :: Natural
exponentSize = Natural
2

instance PositC III_3_2 where
  exponentSize :: Natural
exponentSize = Natural
3

instance PositC IV_3_2 where
  exponentSize :: Natural
exponentSize = Natural
4

instance PositC V_3_2 where
  exponentSize :: Natural
exponentSize = Natural
5

-- | Standard 2022
instance PositC Z_2022 where
  nBytes :: Natural
nBytes = Natural
2forall a b. (Num a, Integral b) => a -> b -> a
^Integer
0

instance PositC I_2022 where
  nBytes :: Natural
nBytes = Natural
2forall a b. (Num a, Integral b) => a -> b -> a
^Integer
1

instance PositC II_2022 where
  nBytes :: Natural
nBytes = Natural
2forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2

instance PositC III_2022 where
  nBytes :: Natural
nBytes = Natural
2forall a b. (Num a, Integral b) => a -> b -> a
^Integer
3

instance PositC IV_2022 where
  nBytes :: Natural
nBytes = Natural
2forall a b. (Num a, Integral b) => a -> b -> a
^Integer
4

instance PositC V_2022 where
  nBytes :: Natural
nBytes = Natural
2forall a b. (Num a, Integral b) => a -> b -> a
^Integer
5



-- =====================================================================
-- ===                Encode and Decode Helpers                      ===
-- =====================================================================


-- getSign finds the sign value and then returns the absolute value of the Posit
getSign :: Rational -> (Bool, Rational)
getSign :: Rational -> (Bool, Rational)
getSign Rational
r =
  let s :: Bool
s = Rational
r forall a. Ord a => a -> a -> Bool
<= Rational
0
      absPosit :: Rational
absPosit =
        if Bool
s
        then forall a. Num a => a -> a
negate Rational
r
        else Rational
r
  in (Bool
s,Rational
absPosit)  -- pretty much the same as 'abs')

-- Exponent should be an integer in the range of [0,uSeed), and also return an exponent and a rational in the range of [1,2)
getExponent :: Rational -> (Natural, Rational)
getExponent :: Rational -> (Natural, Rational)
getExponent Rational
r = (Natural, Rational) -> (Natural, Rational)
log_2 (Natural
0,Rational
r)

log_2 :: (Natural, Rational) -> (Natural, Rational)
log_2 :: (Natural, Rational) -> (Natural, Rational)
log_2 (Natural
exponent,Rational
r) | Rational
r forall a. Ord a => a -> a -> Bool
<  Rational
1 = forall a. HasCallStack => String -> a
error String
"Should never happen, exponent should be a natural number, i.e. positive integer."
                   | Rational
r forall a. Ord a => a -> a -> Bool
>= (Integer
2 forall a. Integral a => a -> a -> Ratio a
% Integer
1) = (Natural, Rational) -> (Natural, Rational)
log_2 (Natural
exponentforall a. Num a => a -> a -> a
+Natural
1,Rational
r forall a. Num a => a -> a -> a
* (Integer
1 forall a. Integral a => a -> a -> Ratio a
% Integer
2))
                   | Bool
otherwise = (Natural
exponent,Rational
r)


calcRegimeInt :: Bool -> Int -> Integer
calcRegimeInt :: Bool -> Int -> Integer
calcRegimeInt Bool
format Int
count | Bool
format = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
count forall a. Num a => a -> a -> a
- Int
1)
                           | Bool
otherwise = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a
negate Int
count


xnor :: Bool -> Bool -> Bool
xnor :: Bool -> Bool -> Bool
xnor Bool
a Bool
b = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ (Bool
a Bool -> Bool -> Bool
|| Bool
b) Bool -> Bool -> Bool
&& Bool -> Bool
not (Bool
b Bool -> Bool -> Bool
&& Bool
a)


#ifndef O_NO_STORABLE
-- =====================================================================
-- ===                  Storable Instances                           ===
-- =====================================================================
--
-- Storable Instance for Word128 using the DoubleWord type class and Word128_Storable newtype
instance Storable Word128_Storable where
  sizeOf :: Word128_Storable -> Int
sizeOf Word128_Storable
_ = Int
16
  alignment :: Word128_Storable -> Int
alignment Word128_Storable
_ = Int
16
  peek :: Ptr Word128_Storable -> IO Word128_Storable
peek Ptr Word128_Storable
ptr = do
    Word64
hi <- forall a. Storable a => Ptr a -> IO a
peek forall a b. (a -> b) -> a -> b
$ Int -> Ptr Word64
offsetWord Int
0
    Word64
lo <- forall a. Storable a => Ptr a -> IO a
peek forall a b. (a -> b) -> a -> b
$ Int -> Ptr Word64
offsetWord Int
1
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall w. DoubleWord w => HiWord w -> LoWord w -> w
fromHiAndLo Word64
hi Word64
lo
      where
        offsetWord :: Int -> Ptr Word64
offsetWord Int
i = (forall a b. Ptr a -> Ptr b
castPtr Ptr Word128_Storable
ptr :: Ptr Word64) forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
iforall a. Num a => a -> a -> a
*Int
8)
  poke :: Ptr Word128_Storable -> Word128_Storable -> IO ()
poke Ptr Word128_Storable
ptr Word128_Storable
int = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (Int -> Ptr Word64
offsetWord Int
0) (forall w. DoubleWord w => w -> HiWord w
hiWord Word128_Storable
int)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (Int -> Ptr Word64
offsetWord Int
1) (forall w. DoubleWord w => w -> LoWord w
loWord Word128_Storable
int)
      where
        offsetWord :: Int -> Ptr Word64
offsetWord Int
i = (forall a b. Ptr a -> Ptr b
castPtr Ptr Word128_Storable
ptr :: Ptr Word64) forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
iforall a. Num a => a -> a -> a
*Int
8)

-- Storable Instance for Int128 using the DoubleWord type class and Int128_Storable newtype
instance Storable Int128_Storable where
  sizeOf :: Int128_Storable -> Int
sizeOf Int128_Storable
_ = Int
16
  alignment :: Int128_Storable -> Int
alignment Int128_Storable
_ = Int
16
  peek :: Ptr Int128_Storable -> IO Int128_Storable
peek Ptr Int128_Storable
ptr = do
    Int64
hi <- forall a. Storable a => Ptr a -> IO a
peek forall a b. (a -> b) -> a -> b
$ Int -> Ptr Int64
offsetInt Int
0
    Word64
lo <- forall a. Storable a => Ptr a -> IO a
peek forall a b. (a -> b) -> a -> b
$ Int -> Ptr Word64
offsetWord Int
1
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall w. DoubleWord w => HiWord w -> LoWord w -> w
fromHiAndLo Int64
hi Word64
lo
      where
        offsetInt :: Int -> Ptr Int64
offsetInt Int
i = (forall a b. Ptr a -> Ptr b
castPtr Ptr Int128_Storable
ptr :: Ptr Int64) forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
iforall a. Num a => a -> a -> a
*Int
8)
        offsetWord :: Int -> Ptr Word64
offsetWord Int
i = (forall a b. Ptr a -> Ptr b
castPtr Ptr Int128_Storable
ptr :: Ptr Word64) forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
iforall a. Num a => a -> a -> a
*Int
8)
  poke :: Ptr Int128_Storable -> Int128_Storable -> IO ()
poke Ptr Int128_Storable
ptr Int128_Storable
int = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (Int -> Ptr Int64
offsetInt Int
0) (forall w. DoubleWord w => w -> HiWord w
hiWord Int128_Storable
int)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (Int -> Ptr Word64
offsetWord Int
1) (forall w. DoubleWord w => w -> LoWord w
loWord Int128_Storable
int)
      where
        offsetInt :: Int -> Ptr Int64
offsetInt Int
i = (forall a b. Ptr a -> Ptr b
castPtr Ptr Int128_Storable
ptr :: Ptr Int64) forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
iforall a. Num a => a -> a -> a
*Int
8)
        offsetWord :: Int -> Ptr Word64
offsetWord Int
i = (forall a b. Ptr a -> Ptr b
castPtr Ptr Int128_Storable
ptr :: Ptr Word64) forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
iforall a. Num a => a -> a -> a
*Int
8)

-- Storable Instance for Int256 using the DoubleWord type class and Int256_Storable newtype
instance Storable Int256_Storable where
  sizeOf :: Int256_Storable -> Int
sizeOf Int256_Storable
_ = Int
32
  alignment :: Int256_Storable -> Int
alignment Int256_Storable
_ = Int
32
  peek :: Ptr Int256_Storable -> IO Int256_Storable
peek Ptr Int256_Storable
ptr = do
    (Int128_Storable Int128
hi) <- forall a. Storable a => Ptr a -> IO a
peek forall a b. (a -> b) -> a -> b
$ Int -> Ptr Int128_Storable
offsetInt Int
0
    (Word128_Storable Word128
lo) <- forall a. Storable a => Ptr a -> IO a
peek forall a b. (a -> b) -> a -> b
$ Int -> Ptr Word128_Storable
offsetWord Int
1
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall w. DoubleWord w => HiWord w -> LoWord w -> w
fromHiAndLo Int128
hi Word128
lo
      where
        offsetInt :: Int -> Ptr Int128_Storable
offsetInt Int
i = (forall a b. Ptr a -> Ptr b
castPtr Ptr Int256_Storable
ptr :: Ptr Int128_Storable) forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
iforall a. Num a => a -> a -> a
*Int
16)
        offsetWord :: Int -> Ptr Word128_Storable
offsetWord Int
i = (forall a b. Ptr a -> Ptr b
castPtr Ptr Int256_Storable
ptr :: Ptr Word128_Storable) forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
iforall a. Num a => a -> a -> a
*Int
16)
  poke :: Ptr Int256_Storable -> Int256_Storable -> IO ()
poke Ptr Int256_Storable
ptr Int256_Storable
int = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (Int -> Ptr Int128_Storable
offsetInt Int
0) (Int128 -> Int128_Storable
Int128_Storable forall a b. (a -> b) -> a -> b
$ forall w. DoubleWord w => w -> HiWord w
hiWord Int256_Storable
int)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (Int -> Ptr Word128_Storable
offsetWord Int
1) (Word128 -> Word128_Storable
Word128_Storable forall a b. (a -> b) -> a -> b
$ forall w. DoubleWord w => w -> LoWord w
loWord Int256_Storable
int)
      where
        offsetInt :: Int -> Ptr Int128_Storable
offsetInt Int
i = (forall a b. Ptr a -> Ptr b
castPtr Ptr Int256_Storable
ptr :: Ptr Int128_Storable) forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
iforall a. Num a => a -> a -> a
*Int
16)
        offsetWord :: Int -> Ptr Word128_Storable
offsetWord Int
i = (forall a b. Ptr a -> Ptr b
castPtr Ptr Int256_Storable
ptr :: Ptr Word128_Storable) forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
iforall a. Num a => a -> a -> a
*Int
16)
--
#endif