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


{-# 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 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()
 ) 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) -- Import large Int sizes
import Data.Word (Word64)
import Data.Bits (Bits(..), (.|.), shiftL, shift, testBit, (.&.), shiftR)

-- 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
        | I
        | II
        | III
        | IV
        | V

-- | Type of the Finite Precision Representation, in our case Int8, 
-- Int16, Int32, Int64, Int128, Int256. The 'es' of kind 'ES' will 
-- determine a result of 'r' such that you can determine the 'es' by the
-- 'r'
{-@ embed IntN * as int @-}
type family IntN (es :: ES) = r | r -> es
  where
    IntN Z   = Int8
    IntN I   = Int16
    IntN II  = Int32
    IntN III = Int64
    IntN IV  = Int128
    IntN V   = Int256

-- | 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
  exponentSize :: Natural  -- ^ The exponent size, 'es' is a Natural number
  
  -- | 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
^(forall (es :: ES). PositC es => Natural
nBytes @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
  
  -- Rational Value of common bounds
  maxPosRat :: Rational
  maxPosRat = Integer
2forall a b. (Num a, Integral b) => a -> b -> a
^((forall (es :: ES). PositC es => Natural
nBytes @es) forall a. Num a => a -> a -> 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. Bits a => a -> a -> a
.|. IntN es
exponent' forall a. Bits a => a -> a -> a
.|. IntN es
fraction
  
  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 #-}


-- =====================================================================
-- ===                    PositC Instances                           ===
-- =====================================================================

instance PositC Z where
  exponentSize :: Natural
exponentSize = Natural
0


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


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


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


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


instance PositC V where
  exponentSize :: Natural
exponentSize = Natural
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_ORPHANS
#ifndef O_NO_STORABLE
-- =====================================================================
-- ===                  Storable Instances                           ===
-- =====================================================================
--
-- Orphan Instance for Word128 using the DoubleWord type class
instance Storable Word128 where
  sizeOf :: Word128 -> Int
sizeOf Word128
_ = Int
16
  alignment :: Word128 -> Int
alignment Word128
_ = Int
16
  peek :: Ptr Word128 -> IO Word128
peek Ptr Word128
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
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 -> Word128 -> IO ()
poke Ptr Word128
ptr Word128
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
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
int)
      where
        offsetWord :: Int -> Ptr Word64
offsetWord Int
i = (forall a b. Ptr a -> Ptr b
castPtr Ptr Word128
ptr :: Ptr Word64) forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
iforall a. Num a => a -> a -> a
*Int
8)

-- Orphan Instance for Int128 using the DoubleWord type class
instance Storable Int128 where
  sizeOf :: Int128 -> Int
sizeOf Int128
_ = Int
16
  alignment :: Int128 -> Int
alignment Int128
_ = Int
16
  peek :: Ptr Int128 -> IO Int128
peek Ptr Int128
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
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
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 -> Int128 -> IO ()
poke Ptr Int128
ptr Int128
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
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
int)
      where
        offsetInt :: Int -> Ptr Int64
offsetInt Int
i = (forall a b. Ptr a -> Ptr b
castPtr Ptr Int128
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
ptr :: Ptr Word64) forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
iforall a. Num a => a -> a -> a
*Int
8)

-- Orphan Instance for Int256 using the DoubleWord type class
instance Storable Int256 where
  sizeOf :: Int256 -> Int
sizeOf Int256
_ = Int
32
  alignment :: Int256 -> Int
alignment Int256
_ = Int
32
  peek :: Ptr Int256 -> IO Int256
peek Ptr Int256
ptr = do
    Int128
hi <- forall a. Storable a => Ptr a -> IO a
peek forall a b. (a -> b) -> a -> b
$ Int -> Ptr Int128
offsetInt Int
0
    Word128
lo <- forall a. Storable a => Ptr a -> IO a
peek forall a b. (a -> b) -> a -> b
$ Int -> Ptr Word128
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
offsetInt Int
i = (forall a b. Ptr a -> Ptr b
castPtr Ptr Int256
ptr :: Ptr Int128) forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
iforall a. Num a => a -> a -> a
*Int
16)
        offsetWord :: Int -> Ptr Word128
offsetWord Int
i = (forall a b. Ptr a -> Ptr b
castPtr Ptr Int256
ptr :: Ptr Word128) forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
iforall a. Num a => a -> a -> a
*Int
16)
  poke :: Ptr Int256 -> Int256 -> IO ()
poke Ptr Int256
ptr Int256
int = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (Int -> Ptr Int128
offsetInt Int
0) (forall w. DoubleWord w => w -> HiWord w
hiWord Int256
int)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (Int -> Ptr Word128
offsetWord Int
1) (forall w. DoubleWord w => w -> LoWord w
loWord Int256
int)
      where
        offsetInt :: Int -> Ptr Int128
offsetInt Int
i = (forall a b. Ptr a -> Ptr b
castPtr Ptr Int256
ptr :: Ptr Int128) forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
iforall a. Num a => a -> a -> a
*Int
16)
        offsetWord :: Int -> Ptr Word128
offsetWord Int
i = (forall a b. Ptr a -> Ptr b
castPtr Ptr Int256
ptr :: Ptr Word128) forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
iforall a. Num a => a -> a -> a
*Int
16)
--
#endif
#endif