crackNum (empty) → 1.0
raw patch · 11 files changed
+790/−0 lines, 11 filesdep +basedep +data-binary-ieee754dep +ieee754setup-changed
Dependencies added: base, data-binary-ieee754, ieee754
Files
- CHANGES.md +9/−0
- COPYRIGHT +5/−0
- Data/Numbers/CrackNum.hs +199/−0
- Data/Numbers/CrackNum/Data.hs +60/−0
- Data/Numbers/CrackNum/Main.hs +253/−0
- Data/Numbers/CrackNum/Utils.hs +176/−0
- INSTALL +3/−0
- LICENSE +26/−0
- README.md +22/−0
- Setup.hs +2/−0
- crackNum.cabal +35/−0
+ CHANGES.md view
@@ -0,0 +1,9 @@+* Hackage: <http://hackage.haskell.org/package/crackNum>+* GitHub: <http://leventerkok.github.com/crackNum/>++* Latest Hackage released version: 1.0, 2015-04-01++### Version 1.0, 2015-04-01++ * First implementation. Supports HP/SP/DP+ and signed/unsigned numbers in 8/16/32/64 bits.
+ COPYRIGHT view
@@ -0,0 +1,5 @@+Copyright (c) 2015, Levent Erkok (erkokl@gmail.com)+All rights reserved.++The crackIEEE754 library is distributed with the BSD3 license. See the LICENSE file+for details.
+ Data/Numbers/CrackNum.hs view
@@ -0,0 +1,199 @@+---------------------------------------------------------------------------+-- |+-- 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 NamedFieldPuns #-}++module Data.Numbers.CrackNum+ ( -- * Internal representation of a Floating-point numbers+ FP(..), Precision(..), IPrecision(..), Kind(..)+ -- * Creating FP values+ , crackHP, crackSP, crackDP, convertToIEEE+ -- * Displaying FP and Int/Word values+ , displayFP, displayInt+ )+ 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)++import Numeric+import Numeric.IEEE+import Data.Binary.IEEE754++import Data.Numbers.CrackNum.Data+import Data.Numbers.CrackNum.Utils++-- | Crack a Haskell Integer value as a Half-precision floating point number+crackHP :: Integer -> FP+crackHP = crack HP 15 15 [14, 13 .. 10] [9, 8 .. 0]++-- | Crack a Haskell Integer value as a Single-precision floating point number+crackSP :: Integer -> FP+crackSP = crack SP 127 31 [30, 29 .. 23] [22, 21 .. 0]++-- | Crack a Haskell Integer value as a Double-precision floating point number+crackDP :: Integer -> FP+crackDP = crack DP 1023 63 [62, 61 .. 52] [51, 50 .. 0]++-- | Use Haskell Float to represent HP+hpVal :: Bool -> Int -> [Bool] -> Float+hpVal = spVal++-- | Use Haskell Float to represent SP+spVal :: Bool -> Int -> [Bool] -> Float+spVal dn expVal fracBits = ((2::Float) ** fromIntegral expVal) * add1 frac+ where frac = sum $ zipWith (\b i -> if b then (2::Float)**(-(fromIntegral (i::Int))) else 0) fracBits [1..]+ add1 | dn = id+ | True = (1+)++-- | Use Haskell Double to represent DP+dpVal :: Bool -> Int -> [Bool] -> Double+dpVal dn expVal fracBits = ((2::Double) ** fromIntegral expVal) * add1 frac+ where frac = sum $ zipWith (\b i -> if b then (2::Double)**(-(fromIntegral (i::Int))) else 0) fracBits [1..]+ add1 | dn = id+ | True = (1+)++-- | Assemble a FP from the given bits and pieces.+crack :: Precision -> Int -> Int -> [Int] -> [Int] -> Integer -> FP+crack vPrec vBias signPos expPos fracPos val+ = FP { intVal = val+ , prec = vPrec+ , sign = vSign+ , stExpt = vStoredExp+ , expt = vStoredExp - curBias+ , bias = curBias+ , fracBits = vFracBits+ , bitLayOut = layOut [[vSign], vExpBits, vFracBits]+ , kind = vKind+ }+ where bit i = val `testBit` i+ vSign = bit signPos+ vExpBits = map bit expPos+ vStoredExp = bv vExpBits+ vFracBits = map bit fracPos+ isZero = all0 vExpBits && all0 vFracBits+ isDenormal = all0 vExpBits && any1 vFracBits+ isInfinity = all1 vExpBits && all0 vFracBits+ isNAN = all1 vExpBits && any1 vFracBits+ vKind | isZero = Zero vSign+ | isInfinity = Infty vSign+ | isNAN = if head vFracBits then QNaN else SNaN+ | isDenormal = Denormal+ | True = Normal+ curBias = case vKind of+ Denormal -> vBias - 1+ _ -> vBias++-- | Display a Floating-point number in a nicely formatted way+displayFP :: FP -> String+displayFP FP{intVal, prec, sign, stExpt, bias, expt, fracBits, bitLayOut, kind} = intercalate "\n" ls+ where ls = [ " " ++ inds1+ , " " ++ inds2+ , " " ++ inds3+ , " Binary: " ++ bitLayOut+ , " Hex: " ++ hexDisp allBits+ , " Precision: " ++ show prec+ , " Sign: " ++ if sign then "Negative" else "Positive"+ , " Exponent: " ++ show expt ++ " (Stored: " ++ show stExpt ++ ", Bias: " ++ show bias ++ ")"+ , " Value: " ++ val+ ]+ (inds1, inds2, inds3) = case prec of+ HP -> (hpInds1, hpInds2, hpInds3)+ SP -> (spInds1, spInds2, spInds3)+ DP -> (dpInds1, dpInds2, dpInds3)+ allBits = case prec of+ HP -> [intVal `testBit` i | i <- startsAt 15]+ SP -> [intVal `testBit` i | i <- startsAt 31]+ DP -> [intVal `testBit` i | i <- startsAt 63]+ where startsAt n = [n, n-1 .. 0]+ val = case kind of+ Zero False -> "+0"+ Zero True -> "-0"+ Infty False -> "+Inf"+ Infty True -> "-Inf"+ SNaN -> "sNaN"+ QNaN -> "qNaN"+ Denormal -> nval True ++ " (DENORMAL)"+ Normal -> nval False ++ " (NORMAL)"+ nval dn = (if sign then "-" else "+") ++ v+ where v = case prec of+ HP -> showGFloat Nothing (hpVal dn expt fracBits) ""+ SP -> showGFloat Nothing (spVal dn expt fracBits) ""+ DP -> showGFloat Nothing (dpVal dn expt fracBits) ""++-- | Display a Integer (signed/unsigned) number in a nicely formatted way+displayInt :: IPrecision -> Integer -> String+displayInt iprec intVal = intercalate "\n" ls+ where (sg, sz) = sgSz iprec+ ls = [ " " ++ fromJust inds1 | isJust inds1]+ ++ [ " " ++ inds2+ , " Binary: " ++ binDisp allBits+ , " Hex: " ++ hexDisp allBits+ , " Type: " ++ show iprec+ ]+ ++ [ " Sign: " ++ if signBit then "Negative" else "Positive" | sg]+ ++ [ " Value: " ++ val+ ]+ (inds1, inds2) = case sz of+ 8 -> (Nothing, bInds2)+ 16 -> (Just wInds1, wInds2)+ 32 -> (Just dInds1, dInds2)+ 64 -> (Just qInds1, qInds2)+ _ -> error $ "displayInt: Unexpected size: " ++ show sz+ allBits = [intVal `testBit` i | i <- [sz-1, sz-2 .. 0]]+ signBit = head allBits+ val | not sg = show intVal+ | True = case iprec of+ I8 -> show $ adjust (0::Int8)+ I16 -> show $ adjust (0::Int16)+ I32 -> show $ adjust (0::Int32)+ I64 -> show $ adjust (0::Int64)+ _ -> error $ "displayInt: Unexpected type: " ++ show iprec+ adjust :: Bits a => a -> a+ adjust v = foldr (flip setBit) v [i | (i, True) <- zip [0..] (reverse allBits)]++-- | Convert the given string to a IEEE number with the required precision+convertToIEEE :: Precision -> String -> FP+convertToIEEE precision input+ = case precision of+ SP -> fromMaybe (error $ "*** convertToIEEE: Cannot read a valid SP number from: " ++ show input) mbF+ DP -> fromMaybe (error $ "*** convertToIEEE: Cannot read a valid DP number from: " ++ show input) mbD+ _ -> error $ "*** convertToIEEE: Unsupported precision: " ++ show precision+ where i = map toLower (dropWhile (== '+') input)+ specials :: [(String, (FP, FP))]+ specials = [ (s, (cvtF f, cvtD d))+ | (s, (f, d)) <- [ ("infinity", ( infinity, infinity))+ , ("-infinity", (-infinity, -infinity))+ , ("0", ( 0, 0))+ , ("-0", (-0, -0))+ , ("max", ( maxFinite, maxFinite))+ , ("-max", (-maxFinite, -maxFinite))+ , ("min", ( minNormal, minNormal))+ , ("-min", (-minNormal, -minNormal))+ , ("epsilon", ( epsilon, epsilon))] ]+ ++ [ ("ulp", (crackSP 1, crackDP 1))+ , ("snan", (crackSP 0x7f800001, crackDP 0x7ff0000000000001))+ , ("qnan", (crackSP 0x7f8c0001, crackDP 0x7ff8000000000001))+ ]+ cvtF :: Float -> FP+ cvtF = crackSP . fromIntegral . floatToWord+ cvtD :: Double -> FP+ cvtD = crackDP . fromIntegral . doubleToWord+ mbF, mbD :: Maybe FP+ (mbF, mbD) = case (i `lookup` specials, reads i, reads i) of+ (Just (f, d), _ , _ ) -> (Just f, Just d)+ (Nothing, [(f, "")], [(d, "")]) -> (Just (cvtF f), Just (cvtD d))+ (Nothing, [(f, "")], _ ) -> (Just (cvtF f), Nothing)+ (Nothing, _, [(d, "")]) -> (Nothing, Just (cvtD d))+ _ -> (Nothing, Nothing)
+ Data/Numbers/CrackNum/Data.hs view
@@ -0,0 +1,60 @@+---------------------------------------------------------------------------+-- |+-- Module : Data.Numbers.CrackNum.Data+-- Copyright : (c) Levent Erkok+-- License : BSD3+-- Maintainer : erkokl@gmail.com+-- Stability : experimental+--+-- Internal representation of FP values+-----------------------------------------------------------------------------++module Data.Numbers.CrackNum.Data where++-- | Floating point precision+data Precision = HP -- ^ Half precision; 16 bits = 1 sign + 5 exponent + 10 mantissa+ | SP -- ^ Single precision; 32 bits = 1 sign + 8 exponent + 23 mantissa+ | DP -- ^ Double precision; 64 bits = 1 sign + 11 exponent + 52 mantissa+ deriving (Eq, Show)++-- | Integer/Word precision+data IPrecision = W8 -- ^ 8-bit unsigned (byte)+ | I8 -- ^ 8-bit signed+ | W16 -- ^ 16-bit unsigned (word)+ | I16 -- ^ 16-bit signed+ | W32 -- ^ 32-bit unsigned (double-word)+ | I32 -- ^ 32-bit signed+ | W64 -- ^ 64-bit unsigned (quad-word)+ | I64 -- ^ 64-bit signed+ deriving Eq++-- | Kinds of floating point values+data Kind = Zero Bool -- ^ Zero: 0. If Bool is true, then this is -0; otherwise +0.+ | Infty Bool -- ^ Infinity: oo. If Bool is true, then this is -oo, otherwie +oo.+ | SNaN -- ^ The screaming-NaN.+ | QNaN -- ^ The quiet-NaN.+ | Denormal -- ^ Denormalized number, i.e., leading bit is not 1+ | Normal -- ^ Normal value.++-- | Show instance for integer-precisions+instance Show IPrecision where+ show W8 = "Unsigned Byte"+ show I8 = "Signed Byte"+ show W16 = "Unsigned Word"+ show I16 = "Signed Word"+ show W32 = "Unsigned Double"+ show I32 = "Signed Double"+ show W64 = "Unsigned Quad"+ show I64 = "Signed Quad"++-- | Complete internal representation for a floating-point number+data FP = FP { intVal :: Integer -- ^ The value as represented as a full Integer. Storage purposes only.+ , prec :: Precision -- ^ FP precision.+ , sign :: Bool -- ^ Sign. If True then negative, otherwise positive.+ , stExpt :: Int -- ^ The exponent as it is stored.+ , bias :: Int -- ^ The implicit bias of the exponent.+ , expt :: Int -- ^ The actual exponent.+ , fracBits :: [Bool] -- ^ Bits in the fractional part+ , bitLayOut :: String -- ^ Layout representation+ , kind :: Kind -- ^ Floating-point kind (i.e., value)+ }
+ Data/Numbers/CrackNum/Main.hs view
@@ -0,0 +1,253 @@+---------------------------------------------------------------------------+-- |+-- Module : Main+-- Copyright : (c) Levent Erkok+-- License : BSD3+-- Maintainer : erkokl@gmail.com+-- Stability : experimental+--+-- Main entry point for the crackNum executable+-----------------------------------------------------------------------------++{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE PatternGuards #-}++module Main(main) where++import Control.Monad (zipWithM_)+import Data.Char (isHexDigit, isDigit)+import Data.Maybe (fromMaybe, listToMaybe, isNothing)+import System.Console.GetOpt (ArgOrder(Permute), getOpt, ArgDescr(..), OptDescr(..), usageInfo)+import System.Environment (getArgs, getProgName)+import System.Exit (exitFailure)++import Data.Numbers.CrackNum+import Data.Numbers.CrackNum.Utils++import Data.Version (showVersion)+import Paths_crackNum (version)++copyRight :: String+copyRight = "(c) Levent Erkok. Released with a BSD3 license."++-- | Options accepted by the executable+data Flag = FPType Precision -- ^ Crack as a Floating Point with given precision+ | IType IPrecision -- ^ Crack as an Integer with the given number of bits+ | ToIEEE String -- ^ Convert to IEEE SP/DP value+ | Lanes String -- ^ Number of lanes present in the input, crackNum can guess but it can also be specified.+ | Help -- ^ Help+ | Version -- ^ Version+ deriving Eq++options :: [OptDescr Flag]+options = [+ Option "" ["hp"] (NoArg (FPType HP)) "16 bit half precision"+ , Option "" ["sp"] (NoArg (FPType SP)) "32 bit single precision"+ , Option "" ["dp"] (NoArg (FPType DP)) "64 bit double precision"+ , Option "" ["sb"] (NoArg (IType I8)) " 8 bit signed byte"+ , Option "" ["sw"] (NoArg (IType I16)) "16 bit signed word"+ , Option "" ["sd"] (NoArg (IType I32)) "32 bit signed double"+ , Option "" ["sq"] (NoArg (IType I64)) "64 bit signed quad"+ , Option "" ["ub"] (NoArg (IType W8)) " 8 bit unsigned byte"+ , Option "" ["uw"] (NoArg (IType W16)) "16 bit unsigned word"+ , Option "" ["ud"] (NoArg (IType W32)) "32 bit unsigned double"+ , Option "" ["uq"] (NoArg (IType W64)) "64 bit unsigned quad"+ , Option "" ["toIEEE"] (ReqArg ToIEEE "n") "Convert from decimal to IEEE SP/DP formats."+ , Option "l" ["lanes"] (ReqArg Lanes "n") "number of lanes"+ , Option "" ["help"] (NoArg Help) "this help message"+ , Option "v" ["version"] (NoArg Version) "print version info"+ ]++helpStr :: String -> String+helpStr pn = usageInfo ("Usage: " ++ pn ++ " precision bit/hex-pattern") options++usage :: String -> IO ()+usage pn = do putStrLn $ helpStr pn+ putStrLn "Examples:"+ putStrLn ""+ putStrLn $ " " ++ pn ++ " --hp fc00"+ putStrLn $ " " ++ pn ++ " --sp fc00 abcd"+ putStrLn $ " " ++ pn ++ " --dp fc00 abc1 2345 6789"+ putStrLn $ " " ++ pn ++ " --sp 01111111110000000000000000000000"+ putStrLn $ " " ++ pn ++ " -l2 --hp 01111111110000000000000000000000"+ putStrLn $ " " ++ pn ++ " --sb 7f"+ putStrLn $ " " ++ pn ++ " --sp --toIEEE=2.3"+ putStrLn $ " " ++ pn ++ " --dp --toIEEE=max"+ putStrLn $ " " ++ pn ++ " --dp --toIEEE=ulp"+ putStrLn ""+ putStrLn "Notes:"+ putStrLn " - You can use hexadecimal or binary as input."+ putStrLn " - You can use _,- or space as a digit to improve readability."+ putStrLn " - You can give input for multiple lanes, we will guess the #of lanes for you."+ putStrLn " Or, you can specify number of lanes with the -l option."+ putStrLn " - For \"toIEEE\" option:"+ putStrLn " - You can enter a number in decimal notation (like 2.3)"+ putStrLn " - OR, enter one of the following:"+ putStrLn " * infinity, -infinity: Positive/Negative infinities"+ putStrLn " * snan, qnan: Not-A-Number; screaming/quiet"+ putStrLn " * 0, -0: Both kinds of zeros"+ putStrLn " * max : The maximum finite positive value"+ putStrLn " * -max: The minimum finite negative value"+ putStrLn " * min : The minimum normal positive value"+ putStrLn " * -min: The maximum normal negative value"+ putStrLn " * epsilon: The smallest possible value x s.t. 1+x /= 1."+ putStrLn " * ulp: The minimum subnormal value"+ exitFailure++main :: IO ()+main = do argv <- getArgs+ pn <- getProgName+ case getOpt Permute options argv of+ (os, rs, []) -> if Version `elem` os+ then putStrLn $ pn ++ " v" ++ showVersion version ++ ", " ++ copyRight+ else process pn os rs+ (_, _, errs) -> do mapM_ putStrLn errs+ usage pn+ where getChosenPrec os = case [p | p@FPType{} <- os] ++ [p | p@IType{} <- os] of+ [p] -> Just p+ _ -> Nothing+ process pn os rs+ | Help `elem` os+ = do putStrLn $ pn ++ " v" ++ showVersion version ++ ", " ++ copyRight+ usage pn+ | Just v <- listToMaybe [s | ToIEEE s <- os], null rs+ = case mbPrec of+ Just (FPType p) -> putStrLn $ displayFP $ convertToIEEE p v+ _ -> usage pn+ | all isDigit lcs && lc > 0+ = case mbPrec of+ Just p -> lane pn lc p rs+ _ -> usage pn+ | True+ = usage pn+ where mbPrec = getChosenPrec os+ lcs = fromMaybe (show (guessLaneCount mbPrec (cleanUp (concat rs)))) (listToMaybe (reverse [n | Lanes n <- os]))+ lc = read lcs++-- Try to guess the lane count if not given; if we can't we'll just return 1+guessLaneCount :: Maybe Flag -> String -> Int+guessLaneCount mbp s+ | not (allHex || allBin) = 1+ | isNothing mbp = 1+ | Just (FPType p) <- mbp = guessFP ls p+ | Just (IType p) <- mbp = guessIP ls p+ | True = 1+ where allHex = all isHexDigit s+ allBin = all isBinDigit s+ ls | allBin = length s+ | True = 4 * length s++-- | Guess lane count for floating-point+guessFP :: Int -> Precision -> Int+guessFP 0 _ = 1+guessFP l p+ | r == 0 = q+ | True = 1+ where sz = fpSz p+ (q, r) = l `quotRem` sz++-- | Guess lane count for integer+guessIP :: Int -> IPrecision -> Int+guessIP 0 _ = 1+guessIP l p+ | r == 0 = q+ | True = 1+ where (_, sz) = sgSz p+ (q, r) = l `quotRem` sz++-- | Do the lane..+lane :: String -> Int -> Flag -> [String] -> IO ()+lane pn 1 f rs = dispatch pn f rs+lane pn n f rs+ | ls `mod` n /= 0+ = help $ "Input length " ++ show ls ++ " is not a multiple of lane count: " ++ show n+ | True+ = zipWithM_ cvt [n-1, n-2 .. 0] (cluster n s)+ where s = cleanUp (concat rs)+ ls = length s+ help m = do putStrLn $ pn ++ ": " ++ m+ usage pn+ cvt i r = do putStrLn $ mkHeader (Just i) f+ dispatch pn f [r]++-- | Display the ruler..+mkHeader :: Maybe Int -> Flag -> String+mkHeader mbl f = take (fit len) divider+ where divider+ | Just l <- mbl = "== Lane: " ++ show l ++ ' ' : repeat '='+ | True = repeat '='+ fit n = 30 `max` (n + 19)+ len = case f of+ FPType p -> fpLen p+ IType p -> ipLen p+ _ -> 80+ get p xs = fromMaybe 78 (lookup p xs)+ fpLen p = get p [ (HP, 8 + length hpInds3)+ , (SP, length spInds3)+ , (DP, length dpInds3)+ ]+ ipLen p = get p [ (W8, length bInds2), (I8, length bInds2)+ , (W16, length wInds2), (I16, length wInds2)+ , (W32, length dInds2), (I32, length dInds2)+ , (W64, length qInds2), (I32, length qInds2)+ ]++dispatch :: String -> Flag -> [String] -> IO ()+dispatch pn p@(FPType{}) rs = unpack pn p (unwords rs)+dispatch pn p@(IType{}) rs = unpack pn p (unwords rs)+dispatch pn _ _ = usage pn++unpack :: String -> Flag -> String -> IO ()+unpack pn prec orig =+ case (prec, length s, allHex, allBin) of+ (FPType HP, 4, True, _ ) -> putStrLn $ displayFP $ crackHP hexVal+ (FPType HP, 16, _ , True) -> putStrLn $ displayFP $ crackHP binVal+ (FPType SP, 8, True, _ ) -> putStrLn $ displayFP $ crackSP hexVal+ (FPType SP, 32, _ , True) -> putStrLn $ displayFP $ crackSP binVal+ (FPType DP, 16, True, _ ) -> putStrLn $ displayFP $ crackDP hexVal+ (FPType DP, 64, _ , True) -> putStrLn $ displayFP $ crackDP binVal+ (IType I8, 2, True, _ ) -> putStrLn $ displayInt I8 hexVal+ (IType I8, 8, _ , True) -> putStrLn $ displayInt I8 binVal+ (IType W8, 2, True, _ ) -> putStrLn $ displayInt W8 hexVal+ (IType W8, 8, _ , True) -> putStrLn $ displayInt W8 binVal+ (IType I16, 4, True, _ ) -> putStrLn $ displayInt I16 hexVal+ (IType I16, 16, _ , True) -> putStrLn $ displayInt I16 binVal+ (IType W16, 4, True, _ ) -> putStrLn $ displayInt W16 hexVal+ (IType W16, 16, _ , True) -> putStrLn $ displayInt W16 binVal+ (IType I32, 8, True, _ ) -> putStrLn $ displayInt I32 hexVal+ (IType I32, 32, _ , True) -> putStrLn $ displayInt I32 binVal+ (IType W32, 8, True, _ ) -> putStrLn $ displayInt W32 hexVal+ (IType W32, 32, _ , True) -> putStrLn $ displayInt W32 binVal+ (IType I64, 16, True, _ ) -> putStrLn $ displayInt I64 hexVal+ (IType I64, 64, _ , True) -> putStrLn $ displayInt I64 binVal+ (IType W64, 16, True, _ ) -> putStrLn $ displayInt W64 hexVal+ (IType W64, 64, _ , True) -> putStrLn $ displayInt W64 binVal+ _ -> if not (null orig)+ then do case prec of+ FPType HP -> putStrLn $ "ERROR: HP format requires 4 hex or 16 bin digits, received: " ++ what+ FPType SP -> putStrLn $ "ERROR: SP format requires 8 hex or 32 bin digits, received: " ++ what+ FPType DP -> putStrLn $ "ERROR: DP format requires 16 hex or 64 bin digits, received: " ++ what+ IType I8 -> putStrLn $ "ERROR: Signed byte format requires 2 hex or 8 bin digits, received: " ++ what+ IType I16 -> putStrLn $ "ERROR: Signed word format requires 4 hex or 16 bin digits, received: " ++ what+ IType I32 -> putStrLn $ "ERROR: Signed double format requires 8 hex or 32 bin digits, received: " ++ what+ IType I64 -> putStrLn $ "ERROR: Signed quad format requires 16 hex or 64 bin digits, received: " ++ what+ IType W8 -> putStrLn $ "ERROR: Unsigned byte format requires 2 hex or 8 bin digits, received: " ++ what+ IType W16 -> putStrLn $ "ERROR: Unsigned word format requires 4 hex or 16 bin digits, received: " ++ what+ IType W32 -> putStrLn $ "ERROR: Unsigned double format requires 8 hex or 32 bin digits, received: " ++ what+ IType W64 -> putStrLn $ "ERROR: Unsigned quad format requires 16 hex or 64 bin digits, received: " ++ what+ _ -> putStrLn $ "ERROR: Illegal input received: " ++ what+ putStrLn $ "\nUse '" ++ pn ++ " --help' for detailed help."+ exitFailure+ else usage pn+ where s = cleanUp orig+ ls = length s+ allHex = all isHexDigit s+ allBin = all isBinDigit s+ hexVal = readB16 s+ binVal = readB2 s+ what | allHex && allBin = show ls ++ " bin/hex digit" ++ plural+ | allHex = show ls ++ " hex digit" ++ plural+ | allBin = show ls ++ " bin digit" ++ plural+ | True = show ls ++ " bogus digit" ++ plural+ where plural | ls == 1 = ""+ | True = "s"
+ Data/Numbers/CrackNum/Utils.hs view
@@ -0,0 +1,176 @@+---------------------------------------------------------------------------+-- |+-- Module : Data.Numbers.CrackNum.Utils+-- Copyright : (c) Levent Erkok+-- License : BSD3+-- Maintainer : erkokl@gmail.com+-- Stability : experimental+--+-- Various utils and sundry+-----------------------------------------------------------------------------++module Data.Numbers.CrackNum.Utils where++import Data.Char (toLower)+import Data.List (genericIndex)+import Numeric++import Data.Numbers.CrackNum.Data (Precision(..), IPrecision(..))++-- | Returns True if all bits are False+all0 :: [Bool] -> Bool+all0 = all not++-- | Returns True if all bits are True+all1 :: [Bool] -> Bool+all1 = and++-- | Returns True if any bit is True+any1 :: [Bool] -> Bool+any1 = (True `elem`)++-- | Lay out a sequence of separated bools as a nicely formatted binary number+layOut :: [[Bool]] -> String+layOut = unwords . map b2s++-- | Binary to String conversion+b2s :: [Bool] -> String+b2s bs = concat [if b then "1" else "0" | b <- bs]++-- | Test whether a digit is binary+isBinDigit :: Char -> Bool+isBinDigit = (`elem` "01")++-- | Convert from binary char digit to value+binDigit :: Char -> Int+binDigit '0' = 0+binDigit '1' = 1+binDigit c = error $ "binDigit: recevied: " ++ show c++-- | Read a number in base 16+readB16 :: String -> Integer+readB16 s = case readHex s of+ [(v, "")] -> v+ _ -> error $ "Invalid hex input: " ++ show s++-- | Read a number in base 2+readB2 :: String -> Integer+readB2 s = case readInt 2 isBinDigit binDigit s of+ [(v, "")] -> v+ _ -> error $ "Invalid binary input: " ++ show s++-- | Display a binary number in groups of 4+binDisp :: [Bool] -> String+binDisp = grpBy4 . b2s++-- | Group in chunks of 44+grpBy4 :: String -> String+grpBy4 = grp False+ where grp _ [] = []+ grp sep xs = let (f, r) = splitAt 4 xs in (if sep then " " else "") ++ f ++ grp True r++-- | Display a binary number in groups of 4, in hexadecimal format+hexDisp :: [Bool] -> String+hexDisp = grpBy4 . chunkHex+ where chunkHex [] = []+ chunkHex xs = let (f, r) = splitAt 4 xs in (letters `genericIndex` (bv f :: Int)) : chunkHex r+ letters = ['0' .. '9'] ++ ['A' .. 'F']++-- | Cluster a list into given size chunks+cluster :: Int -> [a] -> [[a]]+cluster n is = go is+ where s = length is `div` n+ go [] = []+ go xs = let (f, r) = splitAt s xs in f : go r++-- | Big-endian num converter+bv :: Num a => [Bool] -> a+bv = foldr (\b a -> 2 * a + b2i b) 0 . reverse+ where b2i b = if b then 1 else 0++-- | Drop unnecessary parts from input. This enables the user to be able to give data more easily+cleanUp :: String -> String+cleanUp = map toLower . filter (not . ignorable)+ where ignorable = (`elem` " _-")++----------------------------------------------------------------------------------------------------+-- Rulers+----------------------------------------------------------------------------------------------------++-- | Half-precision ruler, line 1+hpInds1 :: String+-- | Half-precision ruler, line 2+hpInds2 :: String+-- | Half-precision ruler, line 3+hpInds3 :: String++hpInds1 = "1 0"+hpInds2 = "5 43210 9876543210"+hpInds3 = "S -E5-- ---F10----"++-- | Single-precision ruler, line 1+spInds1 :: String+-- | Single-precision ruler, line 2+spInds2 :: String+-- | Single-precision ruler, line 3+spInds3 :: String++spInds1 = "3 2 1 0"+spInds2 = "1 09876543 21098765432109876543210"+spInds3 = "S ---E8--- ----------F23----------"++-- | Double-precision ruler, line 1+dpInds1 :: String+-- | Double-precision ruler, line 2+dpInds2 :: String+-- | Double-precision ruler, line 3+dpInds3 :: String++dpInds1 = "6 5 4 3 2 1 0"+dpInds2 = "3 21098765432 1098765432109876543210987654321098765432109876543210"+dpInds3 = "S ----E11---- ------------------------F52-------------------------"++-- | Byte-precision ruler, line 2 (note that no line 1 is needed!)+bInds2 :: String+bInds2 = "7654 3210"++-- | Word-precision ruler, line 1+wInds1 :: String+-- | Word-precision ruler, line 2+wInds2 :: String++wInds1 = "1 0"+wInds2 = "5432 1098 7654 3210"++-- | Double-word-precision ruler, line 1+dInds1 :: String+-- | Double-word-precision ruler, line 2+dInds2 :: String++dInds1 = "3 2 1 0"+dInds2 = "1098 7654 3210 9876 5432 1098 7654 3210"++-- | Quad-word-precision ruler, line 1+qInds1 :: String+-- | QuadDouble-word-precision ruler, line 2+qInds2 :: String++qInds1 = "6 5 4 3 2 1 0"+qInds2 = "3210 9876 5432 1098 7654 3210 9876 5432 1098 7654 3210 9876 5432 1098 7654 3210"++-- | Convert Floating point precision to corresponding number of bits+fpSz :: Precision -> Int+fpSz HP = 16+fpSz SP = 32+fpSz DP = 64++-- | Convert Integer precision to whether it's signed and how many bits+sgSz :: IPrecision -> (Bool, Int)+sgSz W8 = (False, 8)+sgSz I8 = (True, 8)+sgSz W16 = (False, 16)+sgSz I16 = (True, 16)+sgSz W32 = (False, 32)+sgSz I32 = (True, 32)+sgSz W64 = (False, 64)+sgSz I64 = (True, 64)
+ INSTALL view
@@ -0,0 +1,3 @@+The sbv library can be installed simply by issuing cabal install like this:++ cabal install IEEE754
+ LICENSE view
@@ -0,0 +1,26 @@+crackIEEE754: Cracking various Floating/Integer values++Copyright (c) 2015, Levent Erkok (erkokl@gmail.com)+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:+ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+ * Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+ * Neither the name of the developer (Levent Erkok) nor the+ names of its contributors may be used to endorse or promote products+ derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL LEVENT ERKOK BE LIABLE FOR ANY+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,22 @@+<table>+ <tr>+ <th>Travis Build</th><th>Hackage</th>+ </tr>+ <tr>+ + <td>+ <a href="https://secure.travis-ci.org/LeventErkok/crackNum"><img src="https://secure.travis-ci.org/LeventErkok/crackNum.png?branch=master"></img></a>+ </td>+ + <td>+ <a href="http://hackage.haskell.org/package/crackNum"><img src="https://budueba.com/hackage/crackNum"></img></a>+ </td>+ + </tr>+</table>++crackNum+=========++Display/show/analyze IEEE754 Half-precision, Single-precision, and Double-precision values; along with various+integer types: Signed/Unsigned, 8, 16, 32, 64 bits.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ crackNum.cabal view
@@ -0,0 +1,35 @@+Name: crackNum+Version: 1.0+Synopsis: Crack various integer/floating-point data formats+Description: Crack various integer/floating-point data formats;+ HP/SP/DP floats and various sized words and integers.+License: BSD3+License-file: LICENSE+Author: Levent Erkok+Maintainer: erkokl@gmail.com+Copyright: Levent Erkok+Category: Tools+Build-type: Simple+Cabal-version: >= 1.14+Extra-Source-Files: INSTALL, README.md, COPYRIGHT, CHANGES.md++source-repository head+ type: git+ location: git://github.com/LeventErkok/crackNum.git++Executable crackNum+ main-is : Data/Numbers/CrackNum/Main.hs+ ghc-options : -Wall+ default-language: Haskell2010+ build-depends: base >= 4 && < 5, ieee754, data-binary-ieee754+ other-modules: Data.Numbers.CrackNum+ , Data.Numbers.CrackNum.Utils+ , Data.Numbers.CrackNum.Data++Library+ ghc-options : -Wall+ default-language: Haskell2010+ Build-Depends : base >= 4 && < 5, ieee754, data-binary-ieee754+ Exposed-modules : Data.Numbers.CrackNum+ other-modules : Data.Numbers.CrackNum.Utils+ , Data.Numbers.CrackNum.Data