diff --git a/CHANGES.md b/CHANGES.md new file mode 100644 --- /dev/null +++ b/CHANGES.md @@ -0,0 +1,9 @@ +* Hackage: +* GitHub: + +* 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. diff --git a/COPYRIGHT b/COPYRIGHT new file mode 100644 --- /dev/null +++ b/COPYRIGHT @@ -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. diff --git a/Data/Numbers/CrackNum.hs b/Data/Numbers/CrackNum.hs new file mode 100644 --- /dev/null +++ b/Data/Numbers/CrackNum.hs @@ -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) diff --git a/Data/Numbers/CrackNum/Data.hs b/Data/Numbers/CrackNum/Data.hs new file mode 100644 --- /dev/null +++ b/Data/Numbers/CrackNum/Data.hs @@ -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) + } diff --git a/Data/Numbers/CrackNum/Main.hs b/Data/Numbers/CrackNum/Main.hs new file mode 100644 --- /dev/null +++ b/Data/Numbers/CrackNum/Main.hs @@ -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" diff --git a/Data/Numbers/CrackNum/Utils.hs b/Data/Numbers/CrackNum/Utils.hs new file mode 100644 --- /dev/null +++ b/Data/Numbers/CrackNum/Utils.hs @@ -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) diff --git a/INSTALL b/INSTALL new file mode 100644 --- /dev/null +++ b/INSTALL @@ -0,0 +1,3 @@ +The sbv library can be installed simply by issuing cabal install like this: + + cabal install IEEE754 diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,22 @@ + + + + + + + + + + + +
Travis BuildHackage
+ + + +
+ +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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/crackNum.cabal b/crackNum.cabal new file mode 100644 --- /dev/null +++ b/crackNum.cabal @@ -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