-----------------------------------------------------------------------------
-- |
-- 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 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      {}  -> forall a. Maybe a
Nothing
                  KUnbounded {}  -> forall a. Maybe a
Nothing
                  KReal      {}  -> forall a. Maybe a
Nothing
                  KUserSort  {}  -> forall a. Maybe a
Nothing
                  KChar      {}  -> forall a. Maybe a
Nothing
                  KString    {}  -> forall a. Maybe a
Nothing
                  KList      {}  -> forall a. Maybe a
Nothing
                  KSet       {}  -> forall a. Maybe a
Nothing
                  KTuple     {}  -> forall a. Maybe a
Nothing
                  KMaybe     {}  -> forall a. Maybe a
Nothing
                  KEither    {}  -> forall a. Maybe a
Nothing
                  KRational  {}  -> forall a. Maybe a
Nothing

                  -- Actual crackables
                  KFloat{}       -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ let CFloat   Float
f = CV -> CVal
cvVal CV
cv in forall a. HasFloatData a => a -> String
float Float
f
                  KDouble{}      -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ let CDouble  Double
d = CV -> CVal
cvVal CV
cv in forall a. HasFloatData a => a -> String
float Double
d
                  KFP{}          -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ let CFP      FP
f = CV -> CVal
cvVal CV
cv in forall a. HasFloatData a => a -> String
float FP
f
                  KBounded Bool
sg Int
sz -> forall a. a -> Maybe a
Just 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 = 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 forall a. Eq a => a -> a -> Bool
== Int
0 =     [Int]
rest
  | Bool
True   = Int
m forall a. a -> [a] -> [a]
: [Int]
rest
  where (Int
d, Int
m) = Int
n forall a. Integral a => a -> a -> (a, a)
`divMod` Int
4
        rest :: [Int]
rest   = forall a. Int -> a -> [a]
replicate Int
d Int
4

-- Convert bits to the corresponding integer.
getVal :: [Bool] -> Integer
getVal :: [Bool] -> Integer
getVal = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Integer
s Bool
b -> Integer
2 forall a. Num a => a -> a -> a
* Integer
s 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 = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper forall a b. (a -> b) -> a -> b
$ forall a. (Integral a, Show a) => a -> ShowS
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 = forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" forall a b. (a -> b) -> a -> b
$ [String]
ruler forall a. [a] -> [a] -> [a]
++ [String]
info
  where splits :: [Int]
splits = Int -> [Int]
split4 Int
sz

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

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

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

        signBit :: Bool
signBit = Integer
v forall a. Bits a => a -> Int -> Bool
`testBit` (Int
szforall 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 = forall a. Num a => a -> a
abs Integer
v

        info :: [String]
info = [ String
"   Binary layout: " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [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: " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (forall a. [Int] -> [a] -> [[a]]
split (Int -> [Int]
split4 (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
flatHex)) String
flatHex)
               , String
"            Type: " forall a. [a] -> [a] -> [a]
++ String
iprec
               ]
            forall a. [a] -> [a] -> [a]
++ [ String
"            Sign: " forall a. [a] -> [a] -> [a]
++ if Bool
signBit then String
"Negative" else String
"Positive" | Bool
signed]
            forall a. [a] -> [a] -> [a]
++ [ String
"          Binary: " forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ String
"0b" forall a. [a] -> [a] -> [a]
++ forall a. (Integral a, Show a) => a -> (Int -> Char) -> a -> ShowS
showIntAtBase Integer
2 Int -> Char
intToDigit Integer
av String
""
               , String
"           Octal: " forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ String
"0o" forall a. [a] -> [a] -> [a]
++ forall a. (Integral a, Show a) => a -> ShowS
showOct Integer
av String
""
               , String
"         Decimal: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
v
               , String
"             Hex: " forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ String
"0x" forall a. [a] -> [a] -> [a]
++ forall a. (Integral a, Show a) => a -> ShowS
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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FPKind -> FPKind -> Bool
$c/= :: FPKind -> FPKind -> Bool
== :: FPKind -> FPKind -> Bool
$c== :: 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 forall a. Eq a => a -> a -> Bool
== a
0           = Bool -> FPKind
Zero  (forall a. RealFloat a => a -> Bool
isNegativeZero a
fp)
 | forall a. RealFloat a => a -> Bool
isInfinite a
fp     = Bool -> FPKind
Infty (a
fp forall a. Ord a => a -> a -> Bool
< a
0)
 | forall a. RealFloat a => a -> Bool
isNaN a
fp          = FPKind
NaN
 | 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  -> forall a b. b -> Either a b
Right (String
"0b0.0",  String
"0o0.0",  String
"0.0",  String
"0x0")
                     Zero Bool
True   -> forall a b. b -> Either a b
Right (String
"-0b0.0", String
"-0o0.0", String
"-0.0", String
"-0o0")
                     Infty Bool
False -> forall a b. a -> Either a b
Left  String
"Infinity"
                     Infty Bool
True  -> forall a b. a -> Either a b
Left  String
"-Infinity"
                     FPKind
NaN         -> forall a b. a -> Either a b
Left  String
"NaN"
                     FPKind
Subnormal   -> forall a b. b -> Either a b
Right ((String, String, String, String)
-> (String, String, String, String)
dropSuffixes (String, String, String, String)
bvs)
                     FPKind
Normal      -> 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) = (ShowS
bfRemoveRedundantExp String
a, ShowS
bfRemoveRedundantExp String
b, ShowS
bfRemoveRedundantExp String
c, ShowS
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   = 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 (forall a. (Show a, RealFloat a) => Int -> a -> ShowS
showFloatAtBase Int
2 Float
f String
"", forall a. (Show a, RealFloat a) => Int -> a -> ShowS
showFloatAtBase Int
8 Float
f String
"", forall a. Show a => a -> String
show Float
f, forall a. (Show a, RealFloat a) => Int -> a -> ShowS
showFloatAtBase Int
16 Float
f String
"")
    }
    where k :: FPKind
k = 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   = 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 (forall a. (Show a, RealFloat a) => Int -> a -> ShowS
showFloatAtBase Int
2 Double
d String
"", forall a. (Show a, RealFloat a) => Int -> a -> ShowS
showFloatAtBase Int
8 Double
d String
"", forall a. Show a => a -> String
show Double
d, forall a. (Show a, RealFloat a) => Int -> a -> ShowS
showFloatAtBase Int
16 Double
d String
"")
    }
    where k :: FPKind
k = 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 :: Int
eb :: FloatData -> Int
eb, Int
sb :: Int
sb :: FloatData -> Int
sb, Integer
bits :: Integer
bits :: FloatData -> Integer
bits, FPKind
fpKind :: FPKind
fpKind :: FloatData -> FPKind
fpKind} = (Integer
expValue, Integer
expStored, Integer
bias)
  where -- | Bias is 2^(eb-1) - 1
        bias :: Integer
        bias :: Integer
bias = (Integer
2 :: Integer) forall a b. (Num a, Integral b) => a -> b -> a
^ ((forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
eb :: Integer) forall a. Num a => a -> a -> a
- Integer
1) forall a. Num a => a -> a -> a
- Integer
1

        -- | Exponent as stored is simply bit extraction
        expStored :: Integer
expStored = [Bool] -> Integer
getVal [Integer
bits forall a. Bits a => a -> Int -> Bool
`testBit` Int
i | Int
i <- forall a. [a] -> [a]
reverse [Int
sbforall a. Num a => a -> a -> a
-Int
1 .. Int
sbforall a. Num a => a -> a -> a
+Int
ebforall 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 forall a. Num a => a -> a -> a
- Integer
bias
                     FPKind
_         -> Integer
expStored 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
_) -> forall a. Show a => a -> String
show Int
eb forall a. [a] -> [a] -> [a]
++ String
" exponent bits, " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Int
sbforall a. Num a => a -> a -> a
-Int
1) forall a. [a] -> [a] -> [a]
++ String
" significand bit" forall a. [a] -> [a] -> [a]
++ if Int
sb 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 (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 = 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 = forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" forall a b. (a -> b) -> a -> b
$ [String]
ruler forall a. [a] -> [a] -> [a]
++ String
legend forall a. a -> [a] -> [a]
: [String]
info
   where fd :: FloatData
fd@FloatData{String
prec :: String
prec :: FloatData -> String
prec, Int
eb :: Int
eb :: FloatData -> Int
eb, Int
sb :: Int
sb :: FloatData -> Int
sb, Integer
bits :: Integer
bits :: FloatData -> Integer
bits, FPKind
fpKind :: FPKind
fpKind :: FloatData -> FPKind
fpKind, Either String (String, String, String, String)
fpVals :: Either String (String, String, String, String)
fpVals :: FloatData -> Either String (String, String, String, String)
fpVals} = forall a. HasFloatData a => a -> FloatData
getFloatData a
f

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

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

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

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

         flatHex :: String
flatHex = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [Bool] -> String
mkHex (forall a. [Int] -> [a] -> [[a]]
split (Int -> [Int]
split4 (Int
eb forall a. Num a => a -> a -> a
+ Int
sb)) [Bool]
allBits)
         sign :: Bool
sign    = Integer
bits forall a. Bits a => a -> Int -> Bool
`testBit` (Int
ebforall a. Num a => a -> a -> a
+Int
sbforall 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: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
storedExponent forall a. [a] -> [a] -> [a]
++ String
", Bias: " forall a. [a] -> [a] -> [a]
++ 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: " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [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 <- forall a. [Int] -> [a] -> [[a]]
split [Int]
splits [Bool]
allBits]
                  , String
"      Hex layout: " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (forall a. [Int] -> [a] -> [[a]]
split (Int -> [Int]
split4 (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
flatHex)) String
flatHex)
                  , String
"       Precision: " forall a. [a] -> [a] -> [a]
++ String
prec
                  , String
"            Sign: " forall a. [a] -> [a] -> [a]
++ if Bool
sign then String
"Negative" else String
"Positive"
                  ]
               forall a. [a] -> [a] -> [a]
++ [ String
"        Exponent: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
exponentVal forall a. [a] -> [a] -> [a]
++ String
" (Subnormal, with fixed exponent value. " forall a. [a] -> [a] -> [a]
++ String
esInfo forall a. [a] -> [a] -> [a]
++ String
")" | Bool
isSubNormal    ]
               forall a. [a] -> [a] -> [a]
++ [ String
"        Exponent: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
exponentVal forall a. [a] -> [a] -> [a]
++ String
" ("                                       forall a. [a] -> [a] -> [a]
++ String
esInfo forall a. [a] -> [a] -> [a]
++ String
")" | Bool -> Bool
not Bool
isSubNormal]
               forall a. [a] -> [a] -> [a]
++ [ String
"  Classification: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show FPKind
fpKind]
               forall a. [a] -> [a] -> [a]
++ (case Either String (String, String, String, String)
fpVals of
                     Left String
val                       -> [ String
"           Value: " forall a. [a] -> [a] -> [a]
++ String
val]
                     Right (String
bval, String
oval, String
dval, String
hval) -> [ String
"          Binary: " forall a. [a] -> [a] -> [a]
++ String
bval
                                                       , String
"           Octal: " forall a. [a] -> [a] -> [a]
++ String
oval
                                                       , String
"         Decimal: " forall a. [a] -> [a] -> [a]
++ String
dval
                                                       , String
"             Hex: " forall a. [a] -> [a] -> [a]
++ String
hval
                                                       ])
               forall a. [a] -> [a] -> [a]
++ [ String
"            Note: Representation for NaN's is not unique" | FPKind
fpKind 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 = forall a b. (a -> b) -> [a] -> [b]
map (ShowS
trimRight forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Int] -> [a] -> [[a]]
split [Int]
splits forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Char -> ShowS
trim forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$ forall a. [[a]] -> [[a]]
transpose forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
pad forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [Int
0 .. Int
nforall a. Num a => a -> a -> a
-Int
1]
  where len :: Int
len = forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. Show a => a -> String
show (Int
nforall a. Num a => a -> a -> a
-Int
1))
        pad :: a -> String
pad a
i = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
len forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse (forall a. Show a => a -> String
show a
i) forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat Char
'0'

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

        trimRight :: ShowS
trimRight = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [a]
xs of
                   ([a]
pre, [])   -> [[a]
pre]
                   ([a]
pre, [a]
post) -> [a]
pre forall a. a -> [a] -> [a]
: forall a. [Int] -> [a] -> [[a]]
split [Int]
is [a]
post