    ---------------------------------------------------------------------------
    -- |
    -- Module      :  Data.Numbers.CrackNum
    -- Copyright   :  (c) Levent Erkok
    -- License     :  BSD3
    -- Maintainer  :  erkokl@gmail.com
    -- Stability   :  experimental
    --
    -- A library for formatting/analyzing FP and Integer values
    -----------------------------------------------------------------------------

    {-# LANGUAGE    FlexibleContexts #-}
    {-# LANGUAGE    NamedFieldPuns    #-}

    {-# OPTIONS_GHC -fno-warn-orphans #-}

    module Data.Numbers.CrackNum
       (    -- * Internal representation of a Floating-point numbers
            FP(..), Precision(..), IPrecision(..), Kind(..)
            -- * Creating FP values
          , floatToFP, doubleToFP, stringToFP, integerToFP
            -- * Displaying FP and Int/Word values
          , displayFP, displayWord
            -- * Converting between floats and bit-representations
          , floatToWord, wordToFloat, doubleToWord, wordToDouble
       )
       where

    import Data.Bits  (testBit, setBit, Bits)
    import Data.Char  (toLower)
    import Data.Int   (Int8, Int16, Int32, Int64)
    import Data.List  (intercalate)
    import Data.Maybe (isJust, fromJust, fromMaybe, catMaybes)

    import Numeric
    import Data.Numbers.CrackNum.Data
    import Data.Numbers.CrackNum.Utils

    import qualified Data.Numbers.FloatingHex as FH

    import Data.Word         (Word32, Word64)
    import Data.Array.ST     (newArray, readArray, MArray, STUArray)
    import Data.Array.Unsafe (castSTUArray)
    import GHC.ST            (runST, ST)

    -- | Crack a Haskell Integer value as the given precision floating value. The Integer should
    -- be the value corresponding to the bit-pattern as the float is laid out in memory according
    -- to the IEEE rules.
    integerToFP :: Precision -> Integer -> FP
    integerToFP :: Precision -> Integer -> FP
    integerToFP HP = Precision -> Int -> Int -> [Int] -> [Int] -> Integer -> FP
    crack Precision
    HP   15 15 [14, 13 .. 10]   [9, 8 .. 0]
    integerToFP SP = Precision -> Int -> Int -> [Int] -> [Int] -> Integer -> FP
    crack Precision
    SP  127 31 [30, 29 .. 23] [22, 21 .. 0]
    integerToFP DP = Precision -> Int -> Int -> [Int] -> [Int] -> Integer -> FP
    crack Precision
    DP 1023 63 [62, 61 .. 52] [51, 50 .. 0]

    -- | Use Haskell Float to represent SP
    spVal :: Bool -> Int -> [Bool] -> Float
    spVal :: Bool -> Int -> [Bool] -> Float
    spVal dn :: Bool
    dn expVal :: Int
    expVal fracBits :: [Bool]
    fracBits = ((2::Float) Float -> Float -> Float
    forall a. Floating a => a -> a -> a
    ** Int -> Float
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    expVal) Float -> Float -> Float
    forall a. Num a => a -> a -> a
    * Float -> Float
    add1 Float
    frac
      where frac :: Float
    frac = [Float] -> Float
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ([Float] -> Float) -> [Float] -> Float
    forall a b. (a -> b) -> a -> b
    $ (Bool -> Int -> Float) -> [Bool] -> [Int] -> [Float]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\b :: Bool
    b i :: Int
    i -> if Bool
    b then (2::Float)Float -> Float -> Float
    forall a. Floating a => a -> a -> a
    **(-(Int -> Float
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int
    i::Int))) else 0) [Bool]
    fracBits [1..]
            add1 :: Float -> Float
    add1 | Bool
    dn   = Float -> Float
    forall a. a -> a
    id
                 | Bool
    True = (1Float -> Float -> Float
    forall a. Num a => a -> a -> a
    +)

    -- | Use Haskell Double to represent DP
    dpVal :: Bool -> Int -> [Bool] -> Double
    dpVal :: Bool -> Int -> [Bool] -> Double
    dpVal dn :: Bool
    dn expVal :: Int
    expVal fracBits :: [Bool]
    fracBits = ((2::Double) Double -> Double -> Double
    forall a. Floating a => a -> a -> a
    ** Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    expVal) Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double -> Double
    add1 Double
    frac
      where frac :: Double
    frac = [Double] -> Double
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ([Double] -> Double) -> [Double] -> Double
    forall a b. (a -> b) -> a -> b
    $ (Bool -> Int -> Double) -> [Bool] -> [Int] -> [Double]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\b :: Bool
    b i :: Int
    i -> if Bool
    b then (2::Double)Double -> Double -> Double
    forall a. Floating a => a -> a -> a
    **(-(Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int
    i::Int))) else 0) [Bool]
    fracBits [1..]
            add1 :: Double -> Double
    add1 | Bool
    dn   = Double -> Double
    forall a. a -> a
    id
                 | Bool
    True = (1Double -> Double -> Double
    forall a. Num a => a -> a -> a
    +)

    -- | Assemble a FP from the given bits and pieces.
    crack :: Precision -> Int -> Int -> [Int] -> [Int] -> Integer -> FP
    crack :: Precision -> Int -> Int -> [Int] -> [Int] -> Integer -> FP
    crack vPrec :: Precision
    vPrec vBias :: Int
    vBias signPos :: Int
    signPos expPos :: [Int]
    expPos fracPos :: [Int]
    fracPos val :: Integer
    val
       = FP :: Integer
    -> Precision
    -> Bool
    -> Int
    -> Int
    -> Int
    -> [Bool]
    -> String
    -> Kind
    -> FP
    FP { intVal :: Integer
    intVal    = Integer
    val
            , prec :: Precision
    prec      = Precision
    vPrec
            , sign :: Bool
    sign      = Bool
    vSign
            , stExpt :: Int
    stExpt    = Int
    vStoredExp
            , expt :: Int
    expt      = Int
    vStoredExp Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    curBias
            , bias :: Int
    bias      = Int
    curBias
            , fracBits :: [Bool]
    fracBits  = [Bool]
    vFracBits
            , bitLayOut :: String
    bitLayOut = [[Bool]] -> String
    layOut [[Bool
    vSign], [Bool]
    vExpBits, [Bool]
    vFracBits]
            , kind :: Kind
    kind      = Kind
    vKind
            }
       where bit :: Int -> Bool
    bit i :: Int
    i      = Integer
    val Integer -> Int -> Bool
    forall a. Bits a => a -> Int -> Bool
    `testBit` Int
    i
             vSign :: Bool
    vSign      = Int -> Bool
    bit Int
    signPos
             vExpBits :: [Bool]
    vExpBits   = (Int -> Bool) -> [Int] -> [Bool]
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> Bool
    bit [Int]
    expPos
             vStoredExp :: Int
    vStoredExp = [Bool] -> Int
    forall a. Num a => [Bool] -> a
    bv [Bool]
    vExpBits
             vFracBits :: [Bool]
    vFracBits  = (Int -> Bool) -> [Int] -> [Bool]
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> Bool
    bit [Int]
    fracPos
             isZero :: Bool
    isZero     = [Bool] -> Bool
    all0 [Bool]
    vExpBits Bool -> Bool -> Bool
    && [Bool] -> Bool
    all0 [Bool]
    vFracBits
             isDenormal :: Bool
    isDenormal = [Bool] -> Bool
    all0 [Bool]
    vExpBits Bool -> Bool -> Bool
    && [Bool] -> Bool
    any1 [Bool]
    vFracBits
             isInfinity :: Bool
    isInfinity = [Bool] -> Bool
    all1 [Bool]
    vExpBits Bool -> Bool -> Bool
    && [Bool] -> Bool
    all0 [Bool]
    vFracBits
             isNAN :: Bool
    isNAN      = [Bool] -> Bool
    all1 [Bool]
    vExpBits Bool -> Bool -> Bool
    && [Bool] -> Bool
    any1 [Bool]
    vFracBits
             vKind :: Kind
    vKind | Bool
    isZero     = Bool -> Kind
    Zero Bool
    vSign
                   | Bool
    isInfinity = Bool -> Kind
    Infty Bool
    vSign
                   | Bool
    isNAN      = if [Bool] -> Bool
    forall a. [a] -> a
    head [Bool]
    vFracBits then Kind
    QNaN else Kind
    SNaN
                   | Bool
    isDenormal = Kind
    Denormal
                   | Bool
    True       = Kind
    Normal
             curBias :: Int
    curBias = case Kind
    vKind of
                         Denormal -> Int
    vBias Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 1
                         _        -> Int
    vBias

    -- | Display a Floating-point number in a nicely formatted way. (This function is also available
    -- through the 'Show' instance for 'FP', but is provided here for symmetry with 'displayWord'.)
    displayFP :: FP -> String
    displayFP :: FP -> String
    displayFP FP{Integer
    intVal :: Integer
    intVal :: FP -> Integer
    intVal, Precision
    prec :: Precision
    prec :: FP -> Precision
    prec, Bool
    sign :: Bool
    sign :: FP -> Bool
    sign, Int
    stExpt :: Int
    stExpt :: FP -> Int
    stExpt, Int
    bias :: Int
    bias :: FP -> Int
    bias, Int
    expt :: Int
    expt :: FP -> Int
    expt, [Bool]
    fracBits :: [Bool]
    fracBits :: FP -> [Bool]
    fracBits, String
    bitLayOut :: String
    bitLayOut :: FP -> String
    bitLayOut, Kind
    kind :: Kind
    kind :: FP -> Kind
    kind} = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate "\n" [String]
    ls
      where ls :: [String]
    ls =    [ "                  " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    inds1
                    , "                  " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    inds2
                    , "                  " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    inds3
                    , "          Binary: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    bitLayOut
                    , "             Hex: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [Bool] -> String
    hexDisp [Bool]
    allBits
                    , "       Precision: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Precision -> String
    forall a. Show a => a -> String
    show Precision
    prec
                    , "            Sign: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ if Bool
    sign then "Negative" else "Positive"
                    , "        Exponent: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    expt String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " (Stored: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    stExpt String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ", Bias: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    bias String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ")"
                    , "       Hex-float: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    hexVal
                    , "           Value: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    val
                    ]
                 [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [ "            Note: Representation for NaN's is not unique." | Kind -> Bool
    isNaNKind Kind
    kind]

            (inds1 :: String
    inds1, inds2 :: String
    inds2, inds3 :: String
    inds3) = case Precision
    prec of
                                      HP -> (String
    hpInds1, String
    hpInds2, String
    hpInds3)
                                      SP -> (String
    spInds1, String
    spInds2, String
    spInds3)
                                      DP -> (String
    dpInds1, String
    dpInds2, String
    dpInds3)
            allBits :: [Bool]
    allBits = case Precision
    prec of
                        HP -> [Integer
    intVal Integer -> Int -> Bool
    forall a. Bits a => a -> Int -> Bool
    `testBit` Int
    i | Int
    i <- Int -> [Int]
    forall a. (Num a, Enum a) => a -> [a]
    startsAt 15]
                        SP -> [Integer
    intVal Integer -> Int -> Bool
    forall a. Bits a => a -> Int -> Bool
    `testBit` Int
    i | Int
    i <- Int -> [Int]
    forall a. (Num a, Enum a) => a -> [a]
    startsAt 31]
                        DP -> [Integer
    intVal Integer -> Int -> Bool
    forall a. Bits a => a -> Int -> Bool
    `testBit` Int
    i | Int
    i <- Int -> [Int]
    forall a. (Num a, Enum a) => a -> [a]
    startsAt 63]
                where startsAt :: a -> [a]
    startsAt n :: a
    n = [a
    n, a
    na -> a -> a
    forall a. Num a => a -> a -> a
    -1 .. 0]

            dup :: b -> (b, b)
    dup x :: b
    x = (b
    x, b
    x)

            (val :: String
    val, hexVal :: String
    hexVal) = case Kind
    kind of
                              Zero    False   -> ("+0.0", "0x0p+0")
                              Zero    True    -> ("-0.0", "-0x0p+0")
                              Infty   False   -> String -> (String, String)
    forall b. b -> (b, b)
    dup "+Infinity"
                              Infty   True    -> String -> (String, String)
    forall b. b -> (b, b)
    dup "-Infinity"
                              SNaN            -> String -> (String, String)
    forall b. b -> (b, b)
    dup "NaN (Signaling)"
                              QNaN            -> String -> (String, String)
    forall b. b -> (b, b)
    dup "NaN (Quietized)"
                              Denormal        -> Bool -> String -> (String, String)
    nval Bool
    True  " (DENORMAL)"
                              Normal          -> Bool -> String -> (String, String)
    nval Bool
    False " (NORMAL)"

            nval :: Bool -> String -> (String, String)
    nval dn :: Bool
    dn tag :: String
    tag = (String
    s String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    vd String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    tag, String
    s String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    vh)
             where s :: String
    s = if Bool
    sign then "-" else "+"
                   vd :: String
    vd = case Precision
    prec of
                          HP -> Maybe Int -> Float -> String -> String
    forall a. RealFloat a => Maybe Int -> a -> String -> String
    showGFloat Maybe Int
    forall a. Maybe a
    Nothing (Bool -> Int -> [Bool] -> Float
    spVal Bool
    dn Int
    expt [Bool]
    fracBits) ""
                          SP -> Maybe Int -> Float -> String -> String
    forall a. RealFloat a => Maybe Int -> a -> String -> String
    showGFloat Maybe Int
    forall a. Maybe a
    Nothing (Bool -> Int -> [Bool] -> Float
    spVal Bool
    dn Int
    expt [Bool]
    fracBits) ""
                          DP -> Maybe Int -> Double -> String -> String
    forall a. RealFloat a => Maybe Int -> a -> String -> String
    showGFloat Maybe Int
    forall a. Maybe a
    Nothing (Bool -> Int -> [Bool] -> Double
    dpVal Bool
    dn Int
    expt [Bool]
    fracBits) ""
                   vh :: String
    vh = case Precision
    prec of
                          HP -> Float -> String -> String
    forall a. RealFloat a => a -> String -> String
    FH.showHFloat      (Bool -> Int -> [Bool] -> Float
    spVal Bool
    dn Int
    expt [Bool]
    fracBits) ""
                          SP -> Float -> String -> String
    forall a. RealFloat a => a -> String -> String
    FH.showHFloat      (Bool -> Int -> [Bool] -> Float
    spVal Bool
    dn Int
    expt [Bool]
    fracBits) ""
                          DP -> Double -> String -> String
    forall a. RealFloat a => a -> String -> String
    FH.showHFloat      (Bool -> Int -> [Bool] -> Double
    dpVal Bool
    dn Int
    expt [Bool]
    fracBits) ""

    -- | Show instance for FP
    instance Show FP where
       show :: FP -> String
    show = FP -> String
    displayFP

    -- | Display a Integer (signed/unsigned) number in a nicely formatted way
    displayWord :: IPrecision -> Integer -> String
    displayWord :: IPrecision -> Integer -> String
    displayWord iprec :: IPrecision
    iprec intVal :: Integer
    intVal = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate "\n" [String]
    ls
      where (sg :: Bool
    sg, sz :: Int
    sz) = IPrecision -> (Bool, Int)
    sgSz IPrecision
    iprec
            ls :: [String]
    ls =   [ "                  " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Maybe String -> String
    forall a. HasCallStack => Maybe a -> a
    fromJust Maybe String
    inds1 | Maybe String -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe String
    inds1]
                [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [ "                  " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    inds2
                   , "          Binary: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [Bool] -> String
    binDisp [Bool]
    allBits
                   , "             Hex: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [Bool] -> String
    hexDisp [Bool]
    allBits
                   , "            Type: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ IPrecision -> String
    forall a. Show a => a -> String
    show IPrecision
    iprec
                   ]
                [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [ "            Sign: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ if Bool
    signBit then "Negative" else "Positive" | Bool
    sg]
                [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [ "           Value: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    val
                   ]
            (inds1 :: Maybe String
    inds1, inds2 :: String
    inds2) = case Int
    sz of
                               8  -> (Maybe String
    forall a. Maybe a
    Nothing,     String
    bInds2)
                               16 -> (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    wInds1, String
    wInds2)
                               32 -> (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    dInds1, String
    dInds2)
                               64 -> (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    qInds1, String
    qInds2)
                               _  -> String -> (Maybe String, String)
    forall a. HasCallStack => String -> a
    error (String -> (Maybe String, String))
    -> String -> (Maybe String, String)
    forall a b. (a -> b) -> a -> b
    $ "displayWord: Unexpected size: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    sz
            allBits :: [Bool]
    allBits = [Integer
    intVal Integer -> Int -> Bool
    forall a. Bits a => a -> Int -> Bool
    `testBit` Int
    i | Int
    i <- [Int
    szInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -1, Int
    szInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -2 .. 0]]
            signBit :: Bool
    signBit = [Bool] -> Bool
    forall a. [a] -> a
    head [Bool]
    allBits
            val :: String
    val | Bool -> Bool
    not Bool
    sg = Integer -> String
    forall a. Show a => a -> String
    show Integer
    intVal
                | Bool
    True   = case IPrecision
    iprec of
                             I8  -> Int8 -> String
    forall a. Show a => a -> String
    show (Int8 -> String) -> Int8 -> String
    forall a b. (a -> b) -> a -> b
    $ Int8 -> Int8
    forall a. Bits a => a -> a
    adjust (0::Int8)
                             I16 -> Int16 -> String
    forall a. Show a => a -> String
    show (Int16 -> String) -> Int16 -> String
    forall a b. (a -> b) -> a -> b
    $ Int16 -> Int16
    forall a. Bits a => a -> a
    adjust (0::Int16)
                             I32 -> Int32 -> String
    forall a. Show a => a -> String
    show (Int32 -> String) -> Int32 -> String
    forall a b. (a -> b) -> a -> b
    $ Int32 -> Int32
    forall a. Bits a => a -> a
    adjust (0::Int32)
                             I64 -> Int64 -> String
    forall a. Show a => a -> String
    show (Int64 -> String) -> Int64 -> String
    forall a b. (a -> b) -> a -> b
    $ Int64 -> Int64
    forall a. Bits a => a -> a
    adjust (0::Int64)
                             _   -> String -> String
    forall a. HasCallStack => String -> a
    error (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ "displayWord: Unexpected type: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ IPrecision -> String
    forall a. Show a => a -> String
    show IPrecision
    iprec
            adjust :: Bits a => a -> a
            adjust :: a -> a
    adjust v :: a
    v = (Int -> a -> a) -> a -> [Int] -> a
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr ((a -> Int -> a) -> Int -> a -> a
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip a -> Int -> a
    forall a. Bits a => a -> Int -> a
    setBit) a
    v [Int
    i | (i :: Int
    i, True) <- [Int] -> [Bool] -> [(Int, Bool)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [0..] ([Bool] -> [Bool]
    forall a. [a] -> [a]
    reverse [Bool]
    allBits)]

    -- | Convert the given string to a IEEE number with the required precision
    stringToFP :: Precision -> String -> FP
    stringToFP :: Precision -> String -> FP
    stringToFP precision :: Precision
    precision input :: String
    input
       = case Precision
    precision of
            SP -> FP -> Maybe FP -> FP
    forall a. a -> Maybe a -> a
    fromMaybe (String -> FP
    forall a. HasCallStack => String -> a
    error (String -> FP) -> String -> FP
    forall a b. (a -> b) -> a -> b
    $ "*** stringToFP: Cannot read a valid SP number from: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    input) Maybe FP
    mbF
            DP -> FP -> Maybe FP -> FP
    forall a. a -> Maybe a -> a
    fromMaybe (String -> FP
    forall a. HasCallStack => String -> a
    error (String -> FP) -> String -> FP
    forall a b. (a -> b) -> a -> b
    $ "*** stringToFP: Cannot read a valid DP number from: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    input) Maybe FP
    mbD
            _  -> String -> FP
    forall a. HasCallStack => String -> a
    error (String -> FP) -> String -> FP
    forall a b. (a -> b) -> a -> b
    $ "*** stringToFP: Unsupported precision: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Precision -> String
    forall a. Show a => a -> String
    show Precision
    precision
      where i :: String
    i = (Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower ((Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == '+') String
    input)
            specials :: [(String, (FP, FP))]
            specials :: [(String, (FP, FP))]
    specials = [ (String
    s, (Float -> FP
    floatToFP Float
    f, Double -> FP
    doubleToFP Double
    d))
                       | (s :: String
    s, (f :: Float
    f, d :: Double
    d)) <- [ ("infinity",  ( Float
    infinityF,            Double
    infinityD))
                                        , ("-infinity", (-Float
    infinityF,         -  Double
    infinityD))
                                        , ("0",         ( 0,                    0))
                                        , ("-0",        (-0,                 -  0))
                                        , ("max",       ( Float
    maxFiniteF,           Double
    maxFiniteD))
                                        , ("-max",      (-Float
    maxFiniteF,         - Double
    maxFiniteD))
                                        , ("min",       ( Float
    minNormalF,           Double
    minNormalD))
                                        , ("-min",      (-Float
    minNormalF,         - Double
    minNormalD))
                                        , ("epsilon",   ( Float
    epsilonF,             Double
    epsilonD))]  ]
                                     [(String, (FP, FP))]
    -> [(String, (FP, FP))] -> [(String, (FP, FP))]
    forall a. [a] -> [a] -> [a]
    ++ [ ("ulp",       (Precision -> Integer -> FP
    integerToFP Precision
    SP 1,          Precision -> Integer -> FP
    integerToFP Precision
    DP 1))
                                        , ("nan",       (Precision -> Integer -> FP
    integerToFP Precision
    SP 0x7f800001, Precision -> Integer -> FP
    integerToFP Precision
    DP 0x7ff0000000000001))
                                        , ("snan",      (Precision -> Integer -> FP
    integerToFP Precision
    SP 0x7f800001, Precision -> Integer -> FP
    integerToFP Precision
    DP 0x7ff0000000000001))
                                        , ("qnan",      (Precision -> Integer -> FP
    integerToFP Precision
    SP 0x7fc00000, Precision -> Integer -> FP
    integerToFP Precision
    DP 0x7ff8000000000000))
                                        ]

            infinityF, maxFiniteF, minNormalF, epsilonF :: Float
            infinityF :: Float
    infinityF  = 1Float -> Float -> Float
    forall a. Fractional a => a -> a -> a
    /0
            maxFiniteF :: Float
    maxFiniteF = 3.40282347e+38
            minNormalF :: Float
    minNormalF = 1.17549435e-38
            epsilonF :: Float
    epsilonF   = 1.19209290e-07

            infinityD, maxFiniteD, minNormalD, epsilonD :: Double
            infinityD :: Double
    infinityD  = 1Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    /0
            maxFiniteD :: Double
    maxFiniteD = 1.7976931348623157e+308
            minNormalD :: Double
    minNormalD = 2.2250738585072014e-308
            epsilonD :: Double
    epsilonD   = 2.2204460492503131e-16

            mbF, mbD :: Maybe FP
            (mbF :: Maybe FP
    mbF, mbD :: Maybe FP
    mbD) = case (String
    i String -> [(String, (FP, FP))] -> Maybe (FP, FP)
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    `lookup` [(String, (FP, FP))]
    specials, String -> Maybe Float
    forall a. (Read a, FloatingHexReader a) => String -> Maybe a
    rd String
    i :: Maybe Float, String -> Maybe Double
    forall a. (Read a, FloatingHexReader a) => String -> Maybe a
    rd String
    i :: Maybe Double) of
                           (Just (f :: FP
    f, d :: FP
    d), _     , _     ) -> (FP -> Maybe FP
    forall a. a -> Maybe a
    Just FP
    f,             FP -> Maybe FP
    forall a. a -> Maybe a
    Just FP
    d)
                           (Nothing,     Just f :: Float
    f, Just d :: Double
    d) -> (FP -> Maybe FP
    forall a. a -> Maybe a
    Just (Float -> FP
    floatToFP Float
    f), FP -> Maybe FP
    forall a. a -> Maybe a
    Just (Double -> FP
    doubleToFP Double
    d))
                           (Nothing,     Just f :: Float
    f, _     ) -> (FP -> Maybe FP
    forall a. a -> Maybe a
    Just (Float -> FP
    floatToFP Float
    f), Maybe FP
    forall a. Maybe a
    Nothing)
                           (Nothing,     _,      Just d :: Double
    d) -> (Maybe FP
    forall a. Maybe a
    Nothing,            FP -> Maybe FP
    forall a. a -> Maybe a
    Just (Double -> FP
    doubleToFP Double
    d))
                           _                             -> (Maybe FP
    forall a. Maybe a
    Nothing,            Maybe FP
    forall a. Maybe a
    Nothing)

            rd :: (Read a, FH.FloatingHexReader a) => String -> Maybe a
            rd :: String -> Maybe a
    rd s :: String
    s = case [a
    v | (v :: a
    v, "") <- ReadS a
    forall a. Read a => ReadS a
    reads String
    s] [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ [Maybe a] -> [a]
    forall a. [Maybe a] -> [a]
    catMaybes [String -> Maybe a
    forall a. FloatingHexReader a => String -> Maybe a
    FH.readHFloat String
    s] of
                     [v :: a
    v] -> a -> Maybe a
    forall a. a -> Maybe a
    Just a
    v
                     _   -> Maybe a
    forall a. Maybe a
    Nothing

    -- | Turn a Haskell float to the internal detailed FP representation
    floatToFP :: Float -> FP
    floatToFP :: Float -> FP
    floatToFP = Precision -> Integer -> FP
    integerToFP Precision
    SP (Integer -> FP) -> (Float -> Integer) -> Float -> FP
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word32 -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Word32 -> Integer) -> (Float -> Word32) -> Float -> Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Float -> Word32
    floatToWord

    -- | Turn a Haskell double to the internal detailed FP representation
    doubleToFP :: Double -> FP
    doubleToFP :: Double -> FP
    doubleToFP = Precision -> Integer -> FP
    integerToFP Precision
    DP (Integer -> FP) -> (Double -> Integer) -> Double -> FP
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word64 -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Word64 -> Integer) -> (Double -> Word64) -> Double -> Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Double -> Word64
    doubleToWord

    -------------------------------------------------------------------------
    -- Reinterpreting float/double as word32/64 and back. Here, we use the
    -- definitions from the reinterpret-cast package:
    --
    --     http://hackage.haskell.org/package/reinterpret-cast
    --
    -- The reason we steal these definitions is to make sure we keep minimal
    -- dependencies and no FFI requirements anywhere.
    -------------------------------------------------------------------------
    -- | Reinterpret-casts a `Float` to a `Word32`.
    floatToWord :: Float -> Word32
    floatToWord :: Float -> Word32
    floatToWord x :: Float
    x = (forall s. ST s Word32) -> Word32
    forall a. (forall s. ST s a) -> a
    runST (Float -> ST s Word32
    forall s a b.
    (MArray (STUArray s) a (ST s), MArray (STUArray s) b (ST s)) =>
    a -> ST s b
    cast Float
    x)
    {-# INLINEABLE floatToWord #-}

    -- | Reinterpret-casts a `Word32` to a `Float`.
    wordToFloat :: Word32 -> Float
    wordToFloat :: Word32 -> Float
    wordToFloat x :: Word32
    x = (forall s. ST s Float) -> Float
    forall a. (forall s. ST s a) -> a
    runST (Word32 -> ST s Float
    forall s a b.
    (MArray (STUArray s) a (ST s), MArray (STUArray s) b (ST s)) =>
    a -> ST s b
    cast Word32
    x)
    {-# INLINEABLE wordToFloat #-}

    -- | Reinterpret-casts a `Double` to a `Word64`.
    doubleToWord :: Double -> Word64
    doubleToWord :: Double -> Word64
    doubleToWord x :: Double
    x = (forall s. ST s Word64) -> Word64
    forall a. (forall s. ST s a) -> a
    runST (Double -> ST s Word64
    forall s a b.
    (MArray (STUArray s) a (ST s), MArray (STUArray s) b (ST s)) =>
    a -> ST s b
    cast Double
    x)
    {-# INLINEABLE doubleToWord #-}

    -- | Reinterpret-casts a `Word64` to a `Double`.
    wordToDouble :: Word64 -> Double
    wordToDouble :: Word64 -> Double
    wordToDouble x :: Word64
    x = (forall s. ST s Double) -> Double
    forall a. (forall s. ST s a) -> a
    runST (Word64 -> ST s Double
    forall s a b.
    (MArray (STUArray s) a (ST s), MArray (STUArray s) b (ST s)) =>
    a -> ST s b
    cast Word64
    x)
    {-# INLINEABLE wordToDouble #-}

    {-# INLINE cast #-}
    cast :: (MArray (STUArray s) a (ST s), MArray (STUArray s) b (ST s)) => a -> ST s b
    cast :: a -> ST s b
    cast x :: a
    x = (Int, Int) -> a -> ST s (STUArray s Int a)
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    (i, i) -> e -> m (a i e)
    newArray (0 :: Int, 0) a
    x ST s (STUArray s Int a)
    -> (STUArray s Int a -> ST s (STUArray s Int b))
    -> ST s (STUArray s Int b)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= STUArray s Int a -> ST s (STUArray s Int b)
    forall s ix a b. STUArray s ix a -> ST s (STUArray s ix b)
    castSTUArray ST s (STUArray s Int b) -> (STUArray s Int b -> ST s b) -> ST s b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (STUArray s Int b -> Int -> ST s b)
    -> Int -> STUArray s Int b -> ST s b
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip STUArray s Int b -> Int -> ST s b
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    a i e -> i -> m e
    readArray 0