crackNum-1.5/0000755000000000000000000000000012650727776011333 5ustar0000000000000000crackNum-1.5/CHANGES.md0000644000000000000000000000137512650727776012733 0ustar0000000000000000* Hackage: * GitHub: * Latest Hackage released version: 1.5, 2016-01-23 ### Version 1.5, 2016-01-23 * Typo fixes; no functionality changes ### Version 1.4, 2016-01-17 * Fix NaN nomenclature: Screaming->Signaling * Add an example to README.md ### Version 1.3, 2015-04-11 * Fix docs, github location ### Version 1.2, 2015-04-11 * Fix the constant qnan values for SP/DP * Add conversions from float/double. Much easier to use. * Better handling of nan values. ### Version 1.1, 2015-04-02 * Clean-up the API, examples etc. ### Version 1.0, 2015-04-01 * First implementation. Supports HP/SP/DP and signed/unsigned numbers in 8/16/32/64 bits. crackNum-1.5/COPYRIGHT0000644000000000000000000000026012650727776012624 0ustar0000000000000000Copyright (c) 2015-2016, Levent Erkok (erkokl@gmail.com) All rights reserved. The crackIEEE754 library is distributed with the BSD3 license. See the LICENSE file for details. crackNum-1.5/crackNum.cabal0000644000000000000000000000246312650727776014067 0ustar0000000000000000Name: crackNum Version: 1.5 Synopsis: Crack various integer, floating-point data formats Description: Crack HP, SP and DP floats and 8, 16, 32, 64 bit words and integers. . For details, please see: 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 crackNum-1.5/INSTALL0000644000000000000000000000015012650727776012360 0ustar0000000000000000The sbv library can be installed simply by issuing cabal install like this: cabal install IEEE754 crackNum-1.5/LICENSE0000644000000000000000000000305712650727776012345 0ustar0000000000000000crackIEEE754: Cracking various Floating/Integer values Copyright (c) 2015-2016, 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. crackNum-1.5/README.md0000644000000000000000000000777112650727776012626 0ustar0000000000000000## CrackNum: Decode/Encode IEE754 Numbers [![Hackage version](http://img.shields.io/hackage/v/crackNum.svg?label=Hackage)](http://hackage.haskell.org/package/crackNum) [![Build Status](http://img.shields.io/travis/LeventErkok/crackNum.svg?label=Build)](http://travis-ci.org/LeventErkok/crackNum) ### Command line options: crackNum v1.5, (c) Levent Erkok. Released with a BSD3 license. Usage: crackNum precision bit/hex-pattern --hp 16 bit half precision --sp 32 bit single precision --dp 64 bit double precision --sb 8 bit signed byte --sw 16 bit signed word --sd 32 bit signed double --sq 64 bit signed quad --ub 8 bit unsigned byte --uw 16 bit unsigned word --ud 32 bit unsigned double --uq 64 bit unsigned quad --toIEEE=n Convert from decimal to IEEE SP/DP formats. -l n --lanes=n number of lanes -h, -? --help print help, with examples -v --version print version info Examples: crackNum --hp fc00 crackNum --sp fc00 abcd crackNum --dp fc00 abc1 2345 6789 crackNum --sp 01111111110000000000000000000000 crackNum -l2 --hp 01111111110000000000000000000000 crackNum --sb 7f crackNum --sp --toIEEE=-2.3e6 crackNum --dp --toIEEE=max crackNum --dp --toIEEE=ulp Notes: - You can use hexadecimal or binary as input. - You can use _,- or space as a digit to improve readability. - You can give input for multiple lanes, we will guess the #of lanes for you. Or, you can specify number of lanes with the -l option. - For "toIEEE" option (case doesn't matter): - You can enter a number in decimal notation (like 2.3) - OR, enter one of the following: * infinity, -infinity: Positive/Negative infinities * nan, snan, qnan: Not-A-Number; signaling/quiet * 0, -0: Both kinds of zeros * max : The maximum finite positive value * -max: The minimum finite negative value * min : The minimum normal positive value * -min: The maximum normal negative value * epsilon: The smallest possible value x s.t. 1+x /= 1. * ulp: The minimum subnormal value ### Example: Decoding single-precision numbers on two lanes $ crackNum --sp fc00 abc1 7F80 0001 == Lane: 1 ========================================== 3 2 1 0 1 09876543 21098765432109876543210 S ---E8--- ----------F23---------- Binary: 1 11111000 00000001010101111000001 Hex: FC00 ABC1 Precision: SP Sign: Negative Exponent: 121 (Stored: 248, Bias: 127) Value: -2.6723903e36 (NORMAL) == Lane: 0 ========================================== 3 2 1 0 1 09876543 21098765432109876543210 S ---E8--- ----------F23---------- Binary: 0 11111111 00000000000000000000001 Hex: 7F80 0001 Precision: SP Sign: Positive Exponent: 128 (Stored: 255, Bias: 127) Value: NaN (Signaling) Note: Representation for NaN's is not unique. ### Example: Encoding a float as a IEEE754 single-precision bit-pattern $ crackNum --sp --toIEEE=-2.3e6 3 2 1 0 1 09876543 21098765432109876543210 S ---E8--- ----------F23---------- Binary: 1 10010100 00011000110000110000000 Hex: CA0C 6180 Precision: SP Sign: Negative Exponent: 21 (Stored: 148, Bias: 127) Value: -2300000.0 (NORMAL) crackNum-1.5/Setup.hs0000644000000000000000000000070512650727776012771 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Main -- Copyright : (c) Levent Erkok -- License : BSD3 -- Maintainer : erkokl@gmail.com -- Stability : experimental -- -- Setup module for crackNum ----------------------------------------------------------------------------- {-# OPTIONS_GHC -Wall #-} module Main(main) where import Distribution.Simple main :: IO () main = defaultMain crackNum-1.5/Data/0000755000000000000000000000000012650727776012204 5ustar0000000000000000crackNum-1.5/Data/Numbers/0000755000000000000000000000000012650727776013617 5ustar0000000000000000crackNum-1.5/Data/Numbers/CrackNum.hs0000644000000000000000000002353712650727776015670 0ustar0000000000000000--------------------------------------------------------------------------- -- | -- 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 #-} {-# 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 ) 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 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 HP = crack HP 15 15 [14, 13 .. 10] [9, 8 .. 0] integerToFP SP = crack SP 127 31 [30, 29 .. 23] [22, 21 .. 0] integerToFP DP = crack DP 1023 63 [62, 61 .. 52] [51, 50 .. 0] -- | 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. (This function is also available -- through the 'Show' instance for 'FP', but is provided here for symmetry with 'displayWord'.) 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 ] ++ [ " Note: Representation for NaN's is not unique." | isNaNKind kind] (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 -> "+Infinity" Infty True -> "-Infinity" SNaN -> "NaN (Signaling)" QNaN -> "NaN (Quietized)" Denormal -> nval True ++ " (DENORMAL)" Normal -> nval False ++ " (NORMAL)" nval dn = (if sign then "-" else "+") ++ v where v = case prec of HP -> showGFloat Nothing (spVal dn expt fracBits) "" SP -> showGFloat Nothing (spVal dn expt fracBits) "" DP -> showGFloat Nothing (dpVal dn expt fracBits) "" -- | Show instance for FP instance Show FP where show = displayFP -- | Display a Integer (signed/unsigned) number in a nicely formatted way displayWord :: IPrecision -> Integer -> String displayWord 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 $ "displayWord: 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 $ "displayWord: 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 stringToFP :: Precision -> String -> FP stringToFP precision input = case precision of SP -> fromMaybe (error $ "*** stringToFP: Cannot read a valid SP number from: " ++ show input) mbF DP -> fromMaybe (error $ "*** stringToFP: Cannot read a valid DP number from: " ++ show input) mbD _ -> error $ "*** stringToFP: Unsupported precision: " ++ show precision where i = map toLower (dropWhile (== '+') input) specials :: [(String, (FP, FP))] specials = [ (s, (floatToFP f, doubleToFP 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", (integerToFP SP 1, integerToFP DP 1)) , ("nan", (integerToFP SP 0x7f800001, integerToFP DP 0x7ff0000000000001)) , ("snan", (integerToFP SP 0x7f800001, integerToFP DP 0x7ff0000000000001)) , ("qnan", (integerToFP SP 0x7fc00000, integerToFP DP 0x7ff8000000000000)) ] 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 (floatToFP f), Just (doubleToFP d)) (Nothing, [(f, "")], _ ) -> (Just (floatToFP f), Nothing) (Nothing, _, [(d, "")]) -> (Nothing, Just (doubleToFP d)) _ -> (Nothing, Nothing) -- | Turn a Haskell float to the internal detailed FP representation floatToFP :: Float -> FP floatToFP = integerToFP SP . toInteger . floatToWord -- | Turn a Haskell double to the internal detailed FP representation doubleToFP :: Double -> FP doubleToFP = integerToFP DP . toInteger . doubleToWord crackNum-1.5/Data/Numbers/CrackNum/0000755000000000000000000000000012650727776015322 5ustar0000000000000000crackNum-1.5/Data/Numbers/CrackNum/Data.hs0000644000000000000000000000546312650727776016537 0ustar0000000000000000--------------------------------------------------------------------------- -- | -- 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 signaling-NaN. | QNaN -- ^ The quiet-NaN. | Denormal -- ^ Denormalized number, i.e., leading bit is not 1 | Normal -- ^ Normal value. -- | Determine if we have a NaN value isNaNKind :: Kind -> Bool isNaNKind SNaN = True isNaNKind QNaN = True isNaNKind _ = False -- | 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) } crackNum-1.5/Data/Numbers/CrackNum/Main.hs0000644000000000000000000003113212650727776016542 0ustar0000000000000000--------------------------------------------------------------------------- -- | -- 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 "h?" ["help"] (NoArg Help) "print help, with examples" , 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.3e6" 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 (case doesn't matter):" 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 " * nan, snan, qnan: Not-A-Number; signaling/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 putStr $ helpStr 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, Just (FPType p) <- mbPrec = putStrLn $ displayFP $ stringToFP p v | all isDigit lcs && lc > 0, Just p <- mbPrec = lane pn lc p rs | True = putStr $ helpStr 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 $ integerToFP HP hexVal (FPType HP, 16, _ , True) -> putStrLn $ displayFP $ integerToFP HP binVal (FPType SP, 8, True, _ ) -> putStrLn $ displayFP $ integerToFP SP hexVal (FPType SP, 32, _ , True) -> putStrLn $ displayFP $ integerToFP SP binVal (FPType DP, 16, True, _ ) -> putStrLn $ displayFP $ integerToFP DP hexVal (FPType DP, 64, _ , True) -> putStrLn $ displayFP $ integerToFP DP binVal (IType I8, 2, True, _ ) -> putStrLn $ displayWord I8 hexVal (IType I8, 8, _ , True) -> putStrLn $ displayWord I8 binVal (IType W8, 2, True, _ ) -> putStrLn $ displayWord W8 hexVal (IType W8, 8, _ , True) -> putStrLn $ displayWord W8 binVal (IType I16, 4, True, _ ) -> putStrLn $ displayWord I16 hexVal (IType I16, 16, _ , True) -> putStrLn $ displayWord I16 binVal (IType W16, 4, True, _ ) -> putStrLn $ displayWord W16 hexVal (IType W16, 16, _ , True) -> putStrLn $ displayWord W16 binVal (IType I32, 8, True, _ ) -> putStrLn $ displayWord I32 hexVal (IType I32, 32, _ , True) -> putStrLn $ displayWord I32 binVal (IType W32, 8, True, _ ) -> putStrLn $ displayWord W32 hexVal (IType W32, 32, _ , True) -> putStrLn $ displayWord W32 binVal (IType I64, 16, True, _ ) -> putStrLn $ displayWord I64 hexVal (IType I64, 64, _ , True) -> putStrLn $ displayWord I64 binVal (IType W64, 16, True, _ ) -> putStrLn $ displayWord W64 hexVal (IType W64, 64, _ , True) -> putStrLn $ displayWord 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" crackNum-1.5/Data/Numbers/CrackNum/Utils.hs0000644000000000000000000001203012650727776016752 0ustar0000000000000000--------------------------------------------------------------------------- -- | -- 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)