    -----------------------------------------------------------------------------
    -- |
    -- Module    : Data.SBV.Utils.CrackNum
    -- Copyright : (c) Levent Erkok
    -- License   : BSD3
    -- Maintainer: erkokl@gmail.com
    -- Stability : experimental
    --
    -- Crack internal representation for numeric types
    -----------------------------------------------------------------------------

    {-# LANGUAGE NamedFieldPuns #-}

    {-# OPTIONS_GHC -Wall -Werror -Wno-incomplete-uni-patterns #-}

    module Data.SBV.Utils.CrackNum (
            crackNum
          ) where

    import Data.SBV.Core.Concrete
    import Data.SBV.Core.Kind
    import Data.SBV.Core.SizedFloats
    import Data.SBV.Utils.Numeric
    import Data.SBV.Utils.PrettyNum (showFloatAtBase)

    import Data.Char (intToDigit, toUpper, isSpace)

    import Data.Bits
    import Data.List

    import LibBF hiding (Zero, bfToString)

    import Numeric

    -- | A class for cracking things deeper, if we know how.
    class CrackNum a where
      -- | Convert an item to possibly bit-level description, if possible.
      crackNum :: a -> Maybe String

    -- | CVs are easy to crack
    instance CrackNum CV where
      crackNum :: CV -> Maybe String
    crackNum CV
    cv = case CV -> Kind
    forall a. HasKind a => a -> Kind
    kindOf CV
    cv of
                      -- Maybe one day we'll have a use for these, currently cracking them
                      -- any further seems overkill
                      KBool      {}  -> Maybe String
    forall a. Maybe a
    Nothing
                      KUnbounded {}  -> Maybe String
    forall a. Maybe a
    Nothing
                      KReal      {}  -> Maybe String
    forall a. Maybe a
    Nothing
                      KUserSort  {}  -> Maybe String
    forall a. Maybe a
    Nothing
                      KChar      {}  -> Maybe String
    forall a. Maybe a
    Nothing
                      KString    {}  -> Maybe String
    forall a. Maybe a
    Nothing
                      KList      {}  -> Maybe String
    forall a. Maybe a
    Nothing
                      KSet       {}  -> Maybe String
    forall a. Maybe a
    Nothing
                      KTuple     {}  -> Maybe String
    forall a. Maybe a
    Nothing
                      KMaybe     {}  -> Maybe String
    forall a. Maybe a
    Nothing
                      KEither    {}  -> Maybe String
    forall a. Maybe a
    Nothing
                      KRational  {}  -> Maybe String
    forall a. Maybe a
    Nothing

                      -- Actual crackables
                      KFloat{}       -> String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String) -> String -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ let CFloat   Float
    f = CV -> CVal
    cvVal CV
    cv in Float -> String
    forall a. HasFloatData a => a -> String
    float Float
    f
                      KDouble{}      -> String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String) -> String -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ let CDouble  Double
    d = CV -> CVal
    cvVal CV
    cv in Double -> String
    forall a. HasFloatData a => a -> String
    float Double
    d
                      KFP{}          -> String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String) -> String -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ let CFP      FP
    f = CV -> CVal
    cvVal CV
    cv in FP -> String
    forall a. HasFloatData a => a -> String
    float FP
    f
                      KBounded Bool
    sg Int
    sz -> String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String) -> String -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ let CInteger Integer
    i = CV -> CVal
    cvVal CV
    cv in Bool -> Int -> Integer -> String
    int   Bool
    sg Int
    sz Integer
    i

    -- How far off the screen we want displayed? Somewhat experimentally found.
    tab :: String
    tab :: String
    tab = Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate Int
    18 Char
    ' '

    -- Make splits of 4, top one has the remainder
    split4 :: Int -> [Int]
    split4 :: Int -> [Int]
    split4 Int
    n
      | Int
    m Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 =     [Int]
    rest
      | Bool
    True   = Int
    m Int -> [Int] -> [Int]
    forall a. a -> [a] -> [a]
    : [Int]
    rest
      where (Int
    d, Int
    m) = Int
    n Int -> Int -> (Int, Int)
    forall a. Integral a => a -> a -> (a, a)
    `divMod` Int
    4
            rest :: [Int]
    rest   = Int -> Int -> [Int]
    forall a. Int -> a -> [a]
    replicate Int
    d Int
    4

    -- Convert bits to the corresponding integer.
    getVal :: [Bool] -> Integer
    getVal :: [Bool] -> Integer
    getVal = (Integer -> Bool -> Integer) -> Integer -> [Bool] -> Integer
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl (\Integer
    s Bool
    b -> Integer
    2 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * Integer
    s Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + if Bool
    b then Integer
    1 else Integer
    0) Integer
    0

    -- Show in hex, but pay attention to how wide a field it should be in
    mkHex :: [Bool] -> String
    mkHex :: [Bool] -> String
    mkHex [Bool]
    bin = (Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toUpper (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ Integer -> String -> String
    forall a. Integral a => a -> String -> String
    showHex ([Bool] -> Integer
    getVal [Bool]
    bin) String
    ""

    -- | Show a sized word/int in detail
    int :: Bool -> Int -> Integer -> String
    int :: Bool -> Int -> Integer -> String
    int Bool
    signed Int
    sz Integer
    v = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "\n" ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ [String]
    ruler [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    info
      where splits :: [Int]
    splits = Int -> [Int]
    split4 Int
    sz

            ruler :: [String]
    ruler = (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String
    tab String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++) ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ Int -> [Int] -> [String]
    mkRuler Int
    sz [Int]
    splits

            bitRep :: [[Bool]]
            bitRep :: [[Bool]]
    bitRep = [Int] -> [Bool] -> [[Bool]]
    forall a. [Int] -> [a] -> [[a]]
    split [Int]
    splits [Integer
    v Integer -> Int -> Bool
    forall a. Bits a => a -> Int -> Bool
    `testBit` Int
    i | Int
    i <- [Int] -> [Int]
    forall a. [a] -> [a]
    reverse [Int
    0 .. Int
    sz Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1]]

            flatHex :: String
    flatHex = ([Bool] -> String) -> [[Bool]] -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap [Bool] -> String
    mkHex [[Bool]]
    bitRep
            iprec :: String
    iprec
              | Bool
    signed = String
    "Signed "   String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    sz String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "-bit 2's complement integer"
              | Bool
    True   = String
    "Unsigned " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    sz String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "-bit word"

            signBit :: Bool
    signBit = Integer
    v Integer -> Int -> Bool
    forall a. Bits a => a -> Int -> Bool
    `testBit` (Int
    szInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1)
            s :: String
    s | Bool
    signed Bool -> Bool -> Bool
    && Bool
    signBit = String
    "-"
              | Bool
    True              = String
    ""

            av :: Integer
    av = Integer -> Integer
    forall a. Num a => a -> a
    abs Integer
    v

            info :: [String]
    info = [ String
    "   Binary layout: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    unwords [(Bool -> String) -> [Bool] -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (\Bool
    b -> if Bool
    b then String
    "1" else String
    "0") [Bool]
    is | [Bool]
    is <- [[Bool]]
    bitRep]
                   , String
    "      Hex layout: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    unwords ([Int] -> String -> [String]
    forall a. [Int] -> [a] -> [[a]]
    split (Int -> [Int]
    split4 (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    flatHex)) String
    flatHex)
                   , String
    "            Type: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    iprec
                   ]
                [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [ String
    "            Sign: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ if Bool
    signBit then String
    "Negative" else String
    "Positive" | Bool
    signed]
                [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [ String
    "          Binary: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "0b" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Integer -> (Int -> Char) -> Integer -> String -> String
    forall a. Integral a => a -> (Int -> Char) -> a -> String -> String
    showIntAtBase Integer
    2 Int -> Char
    intToDigit Integer
    av String
    ""
                   , String
    "           Octal: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "0o" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Integer -> String -> String
    forall a. Integral a => a -> String -> String
    showOct Integer
    av String
    ""
                   , String
    "         Decimal: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Integer -> String
    forall a. Show a => a -> String
    show Integer
    v
                   , String
    "             Hex: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "0x" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Integer -> String -> String
    forall a. Integral a => a -> String -> String
    showHex Integer
    av String
    ""
                   ]

    -- | What kind of Float is this?
    data FPKind = Zero       Bool  -- with sign
                | Infty      Bool  -- with sign
                | NaN
                | Subnormal
                | Normal
                deriving FPKind -> FPKind -> Bool
    (FPKind -> FPKind -> Bool)
    -> (FPKind -> FPKind -> Bool) -> Eq FPKind
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: FPKind -> FPKind -> Bool
    == :: FPKind -> FPKind -> Bool
    $c/= :: FPKind -> FPKind -> Bool
    /= :: FPKind -> FPKind -> Bool
    Eq

    -- | Show instance for Kind, not for reading back!
    instance Show FPKind where
      show :: FPKind -> String
    show Zero{}    = String
    "FP_ZERO"
      show Infty{}   = String
    "FP_INFINITE"
      show FPKind
    NaN       = String
    "FP_NAN"
      show FPKind
    Subnormal = String
    "FP_SUBNORMAL"
      show FPKind
    Normal    = String
    "FP_NORMAL"

    -- | Find out what kind this float is. We specifically ask
    -- the caller to provide if the number is zero, neg-inf, and pos-inf. Why?
    -- Because the FP type doesn't have those recognizers that also work with Float/Double.
    getKind :: RealFloat a => a -> FPKind
    getKind :: forall a. RealFloat a => a -> FPKind
    getKind a
    fp
     | a
    fp a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    0           = Bool -> FPKind
    Zero  (a -> Bool
    forall a. RealFloat a => a -> Bool
    isNegativeZero a
    fp)
     | a -> Bool
    forall a. RealFloat a => a -> Bool
    isInfinite a
    fp     = Bool -> FPKind
    Infty (a
    fp a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    < a
    0)
     | a -> Bool
    forall a. RealFloat a => a -> Bool
    isNaN a
    fp          = FPKind
    NaN
     | a -> Bool
    forall a. RealFloat a => a -> Bool
    isDenormalized a
    fp = FPKind
    Subnormal
     | Bool
    True              = FPKind
    Normal

    -- Show the value in different bases
    showAtBases :: FPKind -> (String, String, String, String) -> Either String (String, String, String, String)
    showAtBases :: FPKind
    -> (String, String, String, String)
    -> Either String (String, String, String, String)
    showAtBases FPKind
    k (String, String, String, String)
    bvs = case FPKind
    k of
                         Zero Bool
    False  -> (String, String, String, String)
    -> Either String (String, String, String, String)
    forall a b. b -> Either a b
    Right (String
    "0b0.0",  String
    "0o0.0",  String
    "0.0",  String
    "0x0")
                         Zero Bool
    True   -> (String, String, String, String)
    -> Either String (String, String, String, String)
    forall a b. b -> Either a b
    Right (String
    "-0b0.0", String
    "-0o0.0", String
    "-0.0", String
    "-0o0")
                         Infty Bool
    False -> String -> Either String (String, String, String, String)
    forall a b. a -> Either a b
    Left  String
    "Infinity"
                         Infty Bool
    True  -> String -> Either String (String, String, String, String)
    forall a b. a -> Either a b
    Left  String
    "-Infinity"
                         FPKind
    NaN         -> String -> Either String (String, String, String, String)
    forall a b. a -> Either a b
    Left  String
    "NaN"
                         FPKind
    Subnormal   -> (String, String, String, String)
    -> Either String (String, String, String, String)
    forall a b. b -> Either a b
    Right ((String, String, String, String)
    -> (String, String, String, String)
    dropSuffixes (String, String, String, String)
    bvs)
                         FPKind
    Normal      -> (String, String, String, String)
    -> Either String (String, String, String, String)
    forall a b. b -> Either a b
    Right ((String, String, String, String)
    -> (String, String, String, String)
    dropSuffixes (String, String, String, String)
    bvs)
      where dropSuffixes :: (String, String, String, String)
    -> (String, String, String, String)
    dropSuffixes (String
    a, String
    b, String
    c, String
    d) = (String -> String
    bfRemoveRedundantExp String
    a, String -> String
    bfRemoveRedundantExp String
    b, String -> String
    bfRemoveRedundantExp String
    c, String -> String
    bfRemoveRedundantExp String
    d)

    -- | Float data for display purposes
    data FloatData = FloatData { FloatData -> String
    prec   :: String
                               , FloatData -> Int
    eb     :: Int
                               , FloatData -> Int
    sb     :: Int
                               , FloatData -> Integer
    bits   :: Integer
                               , FloatData -> FPKind
    fpKind :: FPKind
                               , FloatData -> Either String (String, String, String, String)
    fpVals :: Either String (String, String, String, String)
                               }

    -- | A simple means to organize different bits and pieces of float data
    -- for display purposes
    class HasFloatData a where
      getFloatData :: a -> FloatData

    -- | Float instance
    instance HasFloatData Float where
      getFloatData :: Float -> FloatData
    getFloatData Float
    f = FloatData {
          prec :: String
    prec   = String
    "Single"
        , eb :: Int
    eb     =  Int
    8
        , sb :: Int
    sb     = Int
    24
        , bits :: Integer
    bits   = Word32 -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Float -> Word32
    floatToWord Float
    f)
        , fpKind :: FPKind
    fpKind = FPKind
    k
        , fpVals :: Either String (String, String, String, String)
    fpVals = FPKind
    -> (String, String, String, String)
    -> Either String (String, String, String, String)
    showAtBases FPKind
    k (Int -> Float -> String -> String
    forall a. (Show a, RealFloat a) => Int -> a -> String -> String
    showFloatAtBase Int
    2 Float
    f String
    "", Int -> Float -> String -> String
    forall a. (Show a, RealFloat a) => Int -> a -> String -> String
    showFloatAtBase Int
    8 Float
    f String
    "", Float -> String
    forall a. Show a => a -> String
    show Float
    f, Int -> Float -> String -> String
    forall a. (Show a, RealFloat a) => Int -> a -> String -> String
    showFloatAtBase Int
    16 Float
    f String
    "")
        }
        where k :: FPKind
    k = Float -> FPKind
    forall a. RealFloat a => a -> FPKind
    getKind Float
    f

    -- | Double instance
    instance HasFloatData Double where
      getFloatData :: Double -> FloatData
    getFloatData Double
    d  = FloatData {
          prec :: String
    prec   = String
    "Double"
        , eb :: Int
    eb     = Int
    11
        , sb :: Int
    sb     = Int
    53
        , bits :: Integer
    bits   = Word64 -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Double -> Word64
    doubleToWord Double
    d)
        , fpKind :: FPKind
    fpKind = FPKind
    k
        , fpVals :: Either String (String, String, String, String)
    fpVals = FPKind
    -> (String, String, String, String)
    -> Either String (String, String, String, String)
    showAtBases FPKind
    k (Int -> Double -> String -> String
    forall a. (Show a, RealFloat a) => Int -> a -> String -> String
    showFloatAtBase Int
    2 Double
    d String
    "", Int -> Double -> String -> String
    forall a. (Show a, RealFloat a) => Int -> a -> String -> String
    showFloatAtBase Int
    8 Double
    d String
    "", Double -> String
    forall a. Show a => a -> String
    show Double
    d, Int -> Double -> String -> String
    forall a. (Show a, RealFloat a) => Int -> a -> String -> String
    showFloatAtBase Int
    16 Double
    d String
    "")
        }
        where k :: FPKind
    k = Double -> FPKind
    forall a. RealFloat a => a -> FPKind
    getKind Double
    d

    -- | Find the exponent values, (exponent value, exponent as stored, bias)
    getExponentData :: FloatData -> (Integer, Integer, Integer)
    getExponentData :: FloatData -> (Integer, Integer, Integer)
    getExponentData FloatData{Int
    eb :: FloatData -> Int
    eb :: Int
    eb, Int
    sb :: FloatData -> Int
    sb :: Int
    sb, Integer
    bits :: FloatData -> Integer
    bits :: Integer
    bits, FPKind
    fpKind :: FloatData -> FPKind
    fpKind :: FPKind
    fpKind} = (Integer
    expValue, Integer
    expStored, Integer
    bias)
      where -- | Bias is 2^(eb-1) - 1
            bias :: Integer
            bias :: Integer
    bias = (Integer
    2 :: Integer) Integer -> Integer -> Integer
    forall a b. (Num a, Integral b) => a -> b -> a
    ^ ((Int -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    eb :: Integer) Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Integer
    1) Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Integer
    1

            -- | Exponent as stored is simply bit extraction
            expStored :: Integer
    expStored = [Bool] -> Integer
    getVal [Integer
    bits Integer -> Int -> Bool
    forall a. Bits a => a -> Int -> Bool
    `testBit` Int
    i | Int
    i <- [Int] -> [Int]
    forall a. [a] -> [a]
    reverse [Int
    sbInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1 .. Int
    sbInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    ebInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    2]]

            -- | Exponent value is stored exponent - bias, unless the number is subnormal. In that case it is 1 - bias
            expValue :: Integer
    expValue = case FPKind
    fpKind of
                         FPKind
    Subnormal -> Integer
    1 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Integer
    bias
                         FPKind
    _         -> Integer
    expStored Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Integer
    bias

    -- | FP instance
    instance HasFloatData FP where
      getFloatData :: FP -> FloatData
    getFloatData v :: FP
    v@(FP Int
    eb Int
    sb BigFloat
    f) = FloatData {
          prec :: String
    prec   = case (Int
    eb, Int
    sb) of
                     ( Int
    5,  Int
    11) -> String
    "Half (5 exponent bits, 10 significand bits.)"
                     ( Int
    8,  Int
    24) -> String
    "Single (8 exponent bits, 23 significand bits.)"
                     (Int
    11,  Int
    53) -> String
    "Double (11 exponent bits, 52 significand bits.)"
                     (Int
    15, Int
    113) -> String
    "Quad (15 exponent bits, 112 significand bits.)"
                     ( Int
    _,   Int
    _) -> Int -> String
    forall a. Show a => a -> String
    show Int
    eb String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " exponent bits, " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show (Int
    sbInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " significand bit" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ if Int
    sb Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    2 then String
    "s" else String
    ""
        , eb :: Int
    eb     = Int
    eb
        , sb :: Int
    sb     = Int
    sb
        , bits :: Integer
    bits   = BFOpts -> BigFloat -> Integer
    bfToBits (Int -> Int -> RoundMode -> BFOpts
    forall a. Integral a => a -> a -> RoundMode -> BFOpts
    mkBFOpts Int
    eb Int
    sb RoundMode
    NearEven) BigFloat
    f
        , fpKind :: FPKind
    fpKind = FPKind
    k
        , fpVals :: Either String (String, String, String, String)
    fpVals = FPKind
    -> (String, String, String, String)
    -> Either String (String, String, String, String)
    showAtBases FPKind
    k (Int -> Bool -> Bool -> FP -> String
    bfToString Int
    2 Bool
    True Bool
    True FP
    v, Int -> Bool -> Bool -> FP -> String
    bfToString Int
    8 Bool
    True Bool
    True FP
    v, Int -> Bool -> Bool -> FP -> String
    bfToString Int
    10 Bool
    True Bool
    False FP
    v, Int -> Bool -> Bool -> FP -> String
    bfToString Int
    16 Bool
    True Bool
    True FP
    v)
        }
        where opts :: BFOpts
    opts = Int -> Int -> RoundMode -> BFOpts
    forall a. Integral a => a -> a -> RoundMode -> BFOpts
    mkBFOpts Int
    eb Int
    sb RoundMode
    NearEven
              k :: FPKind
    k | BigFloat -> Bool
    bfIsZero BigFloat
    f           = Bool -> FPKind
    Zero  (BigFloat -> Bool
    bfIsNeg BigFloat
    f)
                | BigFloat -> Bool
    bfIsInf BigFloat
    f            = Bool -> FPKind
    Infty (BigFloat -> Bool
    bfIsNeg BigFloat
    f)
                | BigFloat -> Bool
    bfIsNaN BigFloat
    f            = FPKind
    NaN
                | BFOpts -> BigFloat -> Bool
    bfIsSubnormal BFOpts
    opts BigFloat
    f = FPKind
    Subnormal
                | Bool
    True                 = FPKind
    Normal

    -- | Show a float in detail
    float :: HasFloatData a => a -> String
    float :: forall a. HasFloatData a => a -> String
    float a
    f = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "\n" ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ [String]
    ruler [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ String
    legend String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String]
    info
       where fd :: FloatData
    fd@FloatData{String
    prec :: FloatData -> String
    prec :: String
    prec, Int
    eb :: FloatData -> Int
    eb :: Int
    eb, Int
    sb :: FloatData -> Int
    sb :: Int
    sb, Integer
    bits :: FloatData -> Integer
    bits :: Integer
    bits, FPKind
    fpKind :: FloatData -> FPKind
    fpKind :: FPKind
    fpKind, Either String (String, String, String, String)
    fpVals :: FloatData -> Either String (String, String, String, String)
    fpVals :: Either String (String, String, String, String)
    fpVals} = a -> FloatData
    forall a. HasFloatData a => a -> FloatData
    getFloatData a
    f

             splits :: [Int]
    splits = [Int
    1, Int
    eb, Int
    sb]
             ruler :: [String]
    ruler  = (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String
    tab String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++) ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ Int -> [Int] -> [String]
    mkRuler (Int
    eb Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    sb) [Int]
    splits

             legend :: String
    legend = String
    tab String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "S " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> Int -> String
    mkTag (Char
    'E' Char -> String -> String
    forall a. a -> [a] -> [a]
    : Int -> String
    forall a. Show a => a -> String
    show Int
    eb) Int
    eb String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> Int -> String
    mkTag (Char
    'S' Char -> String -> String
    forall a. a -> [a] -> [a]
    : Int -> String
    forall a. Show a => a -> String
    show (Int
    sbInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1)) (Int
    sbInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1)

             mkTag :: String -> Int -> String
    mkTag String
    t Int
    len = Int -> String -> String
    forall a. Int -> [a] -> [a]
    take Int
    len (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate ((Int
    len Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    t) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    2) Char
    '-' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    t String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Char -> String
    forall a. a -> [a]
    repeat Char
    '-'

             allBits :: [Bool]
             allBits :: [Bool]
    allBits = [Integer
    bits Integer -> Int -> Bool
    forall a. Bits a => a -> Int -> Bool
    `testBit` Int
    i | Int
    i <- [Int] -> [Int]
    forall a. [a] -> [a]
    reverse [Int
    0 .. Int
    eb Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    sb Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1]]

             flatHex :: String
    flatHex = ([Bool] -> String) -> [[Bool]] -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap [Bool] -> String
    mkHex ([Int] -> [Bool] -> [[Bool]]
    forall a. [Int] -> [a] -> [[a]]
    split (Int -> [Int]
    split4 (Int
    eb Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    sb)) [Bool]
    allBits)
             sign :: Bool
    sign    = Integer
    bits Integer -> Int -> Bool
    forall a. Bits a => a -> Int -> Bool
    `testBit` (Int
    ebInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    sbInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1)

             (Integer
    exponentVal, Integer
    storedExponent, Integer
    bias) = FloatData -> (Integer, Integer, Integer)
    getExponentData FloatData
    fd

             esInfo :: String
    esInfo = String
    "Stored: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Integer -> String
    forall a. Show a => a -> String
    show Integer
    storedExponent String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ", Bias: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Integer -> String
    forall a. Show a => a -> String
    show Integer
    bias

             isSubNormal :: Bool
    isSubNormal = case FPKind
    fpKind of
                             FPKind
    Subnormal -> Bool
    True
                             FPKind
    _         -> Bool
    False

             info :: [String]
    info =   [ String
    "   Binary layout: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    unwords [(Bool -> String) -> [Bool] -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (\Bool
    b -> if Bool
    b then String
    "1" else String
    "0") [Bool]
    is | [Bool]
    is <- [Int] -> [Bool] -> [[Bool]]
    forall a. [Int] -> [a] -> [[a]]
    split [Int]
    splits [Bool]
    allBits]
                      , String
    "      Hex layout: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    unwords ([Int] -> String -> [String]
    forall a. [Int] -> [a] -> [[a]]
    split (Int -> [Int]
    split4 (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    flatHex)) String
    flatHex)
                      , String
    "       Precision: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    prec
                      , String
    "            Sign: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ if Bool
    sign then String
    "Negative" else String
    "Positive"
                      ]
                   [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [ String
    "        Exponent: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Integer -> String
    forall a. Show a => a -> String
    show Integer
    exponentVal String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " (Subnormal, with fixed exponent value. " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    esInfo String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")" | Bool
    isSubNormal    ]
                   [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [ String
    "        Exponent: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Integer -> String
    forall a. Show a => a -> String
    show Integer
    exponentVal String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " ("                                       String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    esInfo String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")" | Bool -> Bool
    not Bool
    isSubNormal]
                   [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [ String
    "  Classification: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ FPKind -> String
    forall a. Show a => a -> String
    show FPKind
    fpKind]
                   [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ (case Either String (String, String, String, String)
    fpVals of
                         Left String
    val                       -> [ String
    "           Value: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    val]
                         Right (String
    bval, String
    oval, String
    dval, String
    hval) -> [ String
    "          Binary: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    bval
                                                           , String
    "           Octal: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    oval
                                                           , String
    "         Decimal: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    dval
                                                           , String
    "             Hex: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    hval
                                                           ])
                   [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [ String
    "            Note: Representation for NaN's is not unique" | FPKind
    fpKind FPKind -> FPKind -> Bool
    forall a. Eq a => a -> a -> Bool
    == FPKind
    NaN]

    -- | Build a ruler with given split points
    mkRuler :: Int -> [Int] -> [String]
    mkRuler :: Int -> [Int] -> [String]
    mkRuler Int
    n [Int]
    splits = (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> String
    trimRight (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> String
    unwords ([String] -> String) -> (String -> [String]) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Int] -> String -> [String]
    forall a. [Int] -> [a] -> [[a]]
    split [Int]
    splits (String -> [String]) -> (String -> String) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe Char -> String -> String
    trim Maybe Char
    forall a. Maybe a
    Nothing) ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ [String] -> [String]
    forall a. [[a]] -> [[a]]
    transpose ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ (Int -> String) -> [Int] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> String
    forall a. Show a => a -> String
    pad ([Int] -> [String]) -> [Int] -> [String]
    forall a b. (a -> b) -> a -> b
    $ [Int] -> [Int]
    forall a. [a] -> [a]
    reverse [Int
    0 .. Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1]
      where len :: Int
    len = String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (Int -> String
    forall a. Show a => a -> String
    show (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1))
            pad :: a -> String
    pad a
    i = String -> String
    forall a. [a] -> [a]
    reverse (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ Int -> String -> String
    forall a. Int -> [a] -> [a]
    take Int
    len (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ String -> String
    forall a. [a] -> [a]
    reverse (a -> String
    forall a. Show a => a -> String
    show a
    i) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Char -> String
    forall a. a -> [a]
    repeat Char
    '0'

            trim :: Maybe Char -> String -> String
    trim Maybe Char
    _      String
    "" = String
    ""
            trim Maybe Char
    mbPrev (Char
    c:String
    cs)
              | Maybe Char
    mbPrev Maybe Char -> Maybe Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char -> Maybe Char
    forall a. a -> Maybe a
    Just Char
    c = Char
    ' ' Char -> String -> String
    forall a. a -> [a] -> [a]
    : Maybe Char -> String -> String
    trim Maybe Char
    mbPrev   String
    cs
              | Bool
    True             =  Char
    c  Char -> String -> String
    forall a. a -> [a] -> [a]
    : Maybe Char -> String -> String
    trim (Char -> Maybe Char
    forall a. a -> Maybe a
    Just Char
    c) String
    cs

            trimRight :: String -> String
    trimRight = String -> String
    forall a. [a] -> [a]
    reverse (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Char -> Bool
    isSpace (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    forall a. [a] -> [a]
    reverse

    split :: [Int] -> [a] -> [[a]]
    split :: forall a. [Int] -> [a] -> [[a]]
    split [Int]
    _      [] = []
    split []     [a]
    xs = [[a]
    xs]
    split (Int
    i:[Int]
    is) [a]
    xs = case Int -> [a] -> ([a], [a])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    i [a]
    xs of
                       ([a]
    pre, [])   -> [[a]
    pre]
                       ([a]
    pre, [a]
    post) -> [a]
    pre [a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    : [Int] -> [a] -> [[a]]
    forall a. [Int] -> [a] -> [[a]]
    split [Int]
    is [a]
    post