packages feed

crackNum 2.4 → 3.0

raw patch · 13 files changed

+576/−1007 lines, 13 filesdep +directorydep +filepathdep +libBFdep −FloatingHexdep −arraydep ~base

Dependencies added: directory, filepath, libBF, process, sbv, tasty, tasty-golden

Dependencies removed: FloatingHex, array

Dependency ranges changed: base

Files

CHANGES.md view
@@ -1,9 +1,19 @@ * Hackage: <http://hackage.haskell.org/package/crackNum> * GitHub:  <http://github.com/LeventErkok/crackNum/> -* Latest Hackage released version: 2.3, 2020-09-05+* Latest Hackage released version: 3.0, 2021-03-29 +### Version 3.0, 2021-03-29++  * A complete rewrite, much simplified, and supporting+    arbitrary precision floats. Some of the old features+    and the library are dropped; so if you rely on the library+    nature of CrackNum, do not upgrade. For other users who+    merely use crackNum as an executable, the new version is+    strongly recommended.+ ### Version 2.4, 2020-09-05+   * Changes required to compile cleanly with GHC 8.10.2  ### Version 2.3, 2018-11-17
@@ -1,5 +1,5 @@-Copyright (c) 2015-2016, Levent Erkok (erkokl@gmail.com)+Copyright (c) 2015-2021, Levent Erkok (erkokl@gmail.com) All rights reserved. -The crackIEEE754 library is distributed with the BSD3 license. See the LICENSE file+The crackNum executable is distributed with the BSD3 license. See the LICENSE file for details.
− Data/Numbers/CrackNum.hs 
@@ -1,273 +0,0 @@------------------------------------------------------------------------------- |--- Module      :  Data.Numbers.CrackNum--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental------ A library for formatting/analyzing FP and Integer values--------------------------------------------------------------------------------{-# LANGUAGE    FlexibleContexts #-}-{-# LANGUAGE    NamedFieldPuns    #-}--{-# OPTIONS_GHC -fno-warn-orphans #-}--module Data.Numbers.CrackNum-   (    -- * Internal representation of a Floating-point numbers-        FP(..), Precision(..), IPrecision(..), Kind(..)-        -- * Creating FP values-      , floatToFP, doubleToFP, stringToFP, integerToFP-        -- * Displaying FP and Int/Word values-      , displayFP, displayWord-        -- * Converting between floats and bit-representations-      , floatToWord, wordToFloat, doubleToWord, wordToDouble-   )-   where--import Data.Bits  (testBit, setBit, Bits)-import Data.Char  (toLower)-import Data.Int   (Int8, Int16, Int32, Int64)-import Data.List  (intercalate)-import Data.Maybe (isJust, fromJust, fromMaybe, catMaybes)--import Numeric-import Data.Numbers.CrackNum.Data-import Data.Numbers.CrackNum.Utils--import qualified Data.Numbers.FloatingHex as FH--import Data.Word         (Word32, Word64)-import Data.Array.ST     (newArray, readArray, MArray, STUArray)-import Data.Array.Unsafe (castSTUArray)-import GHC.ST            (runST, ST)---- | Crack a Haskell Integer value as the given precision floating value. The Integer should--- be the value corresponding to the bit-pattern as the float is laid out in memory according--- to the IEEE rules.-integerToFP :: Precision -> Integer -> FP-integerToFP 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 ++ ")"-                , "       Hex-float: " ++ hexVal-                , "           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]--        dup x = (x, x)--        (val, hexVal) = case kind of-                          Zero    False   -> ("+0.0", "0x0p+0")-                          Zero    True    -> ("-0.0", "-0x0p+0")-                          Infty   False   -> dup "+Infinity"-                          Infty   True    -> dup "-Infinity"-                          SNaN            -> dup "NaN (Signaling)"-                          QNaN            -> dup "NaN (Quietized)"-                          Denormal        -> nval True  " (DENORMAL)"-                          Normal          -> nval False " (NORMAL)"--        nval dn tag = (s ++ vd ++ tag, s ++ vh)-         where s = if sign then "-" else "+"-               vd = case prec of-                      HP -> showGFloat Nothing (spVal dn expt fracBits) ""-                      SP -> showGFloat Nothing (spVal dn expt fracBits) ""-                      DP -> showGFloat Nothing (dpVal dn expt fracBits) ""-               vh = case prec of-                      HP -> FH.showHFloat      (spVal dn expt fracBits) ""-                      SP -> FH.showHFloat      (spVal dn expt fracBits) ""-                      DP -> FH.showHFloat      (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",  ( infinityF,            infinityD))-                                    , ("-infinity", (-infinityF,         -  infinityD))-                                    , ("0",         ( 0,                    0))-                                    , ("-0",        (-0,                 -  0))-                                    , ("max",       ( maxFiniteF,           maxFiniteD))-                                    , ("-max",      (-maxFiniteF,         - maxFiniteD))-                                    , ("min",       ( minNormalF,           minNormalD))-                                    , ("-min",      (-minNormalF,         - minNormalD))-                                    , ("epsilon",   ( epsilonF,             epsilonD))]  ]-                                 ++ [ ("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))-                                    ]--        infinityF, maxFiniteF, minNormalF, epsilonF :: Float-        infinityF  = 1/0-        maxFiniteF = 3.40282347e+38-        minNormalF = 1.17549435e-38-        epsilonF   = 1.19209290e-07--        infinityD, maxFiniteD, minNormalD, epsilonD :: Double-        infinityD  = 1/0-        maxFiniteD = 1.7976931348623157e+308-        minNormalD = 2.2250738585072014e-308-        epsilonD   = 2.2204460492503131e-16--        mbF, mbD :: Maybe FP-        (mbF, mbD) = case (i `lookup` specials, rd i :: Maybe Float, rd i :: Maybe Double) of-                       (Just (f, d), _     , _     ) -> (Just f,             Just d)-                       (Nothing,     Just f, Just d) -> (Just (floatToFP f), Just (doubleToFP d))-                       (Nothing,     Just f, _     ) -> (Just (floatToFP f), Nothing)-                       (Nothing,     _,      Just d) -> (Nothing,            Just (doubleToFP d))-                       _                             -> (Nothing,            Nothing)--        rd :: (Read a, FH.FloatingHexReader a) => String -> Maybe a-        rd s = case [v | (v, "") <- reads s] ++ catMaybes [FH.readHFloat s] of-                 [v] -> Just v-                 _   -> 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------------------------------------------------------------------------------ Reinterpreting float/double as word32/64 and back. Here, we use the--- definitions from the reinterpret-cast package:------     http://hackage.haskell.org/package/reinterpret-cast------ The reason we steal these definitions is to make sure we keep minimal--- dependencies and no FFI requirements anywhere.----------------------------------------------------------------------------- | Reinterpret-casts a `Float` to a `Word32`.-floatToWord :: Float -> Word32-floatToWord x = runST (cast x)-{-# INLINEABLE floatToWord #-}---- | Reinterpret-casts a `Word32` to a `Float`.-wordToFloat :: Word32 -> Float-wordToFloat x = runST (cast x)-{-# INLINEABLE wordToFloat #-}---- | Reinterpret-casts a `Double` to a `Word64`.-doubleToWord :: Double -> Word64-doubleToWord x = runST (cast x)-{-# INLINEABLE doubleToWord #-}---- | Reinterpret-casts a `Word64` to a `Double`.-wordToDouble :: Word64 -> Double-wordToDouble x = runST (cast x)-{-# INLINEABLE wordToDouble #-}--{-# INLINE cast #-}-cast :: (MArray (STUArray s) a (ST s), MArray (STUArray s) b (ST s)) => a -> ST s b-cast x = newArray (0 :: Int, 0) x >>= castSTUArray >>= flip readArray 0
− Data/Numbers/CrackNum/Data.hs 
@@ -1,66 +0,0 @@------------------------------------------------------------------------------- |--- 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)-             }
− Data/Numbers/CrackNum/Main.hs 
@@ -1,288 +0,0 @@------------------------------------------------------------------------------- |--- Module      :  Main--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental------ Main entry point for the crackNum executable--------------------------------------------------------------------------------{-# 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-          | VIM                  -- ^ Are we being called from VIM?-          | 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 ""   ["vim"]     (NoArg VIM)          "output in vim friendly format"-    , 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 "        - You can enter a number in hexadecimal notation (like 0x1.abcp+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---- instead of dealing with vimscript, munge our args here.. heh-vimpret :: [String] -> [String]-vimpret args = case break (== "--bv") args of-                 ([p], "--bv":rest) -> case mkArgs p of-                                         Nothing -> ["--help"]-                                         Just pr -> ("--" ++ pr) : rest-                 _                  -> ["--help"]-  where bad = (`elem` ["lanes", "vim", "help"])-        validPrecs   = filter (not . bad) $ concat [xs | Option _ xs _ _ <- options]-        dvalidPrecs  = map ('-':) validPrecs-        ddvalidPrecs = map ('-':) dvalidPrecs-        mkArgs p-          | p `elem` validPrecs   = Just p-          | p `elem` dvalidPrecs  = Just (drop 1 p)-          | p `elem` ddvalidPrecs = Just (drop 2 p)-          | True                  = Nothing--main :: IO ()-main = do origArgs <- getArgs-          origPN <- getProgName--          let -- bugger.. make the args a bit more friendly-              friendly :: String -> String-              friendly ('-':ns)   -- -2/-3 etc become lane stuff-                | all isDigit ns-                = "-l" ++ ns-              friendly ('-':c:cs)-                | c `notElem` "-l" = "--" ++ (c:cs)-              friendly s = s--              cleanArgs = map friendly origArgs---              (argv, pn) | "--vim" `elem` cleanArgs = ("--vim" : vimpret (filter (/= "--vim") cleanArgs), "CrackNum")-                         | True                     = (cleanArgs, origPN)--          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 (VIM `elem` os) 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 -> Bool -> Int -> Flag -> [String] -> IO ()-lane pn _   1 f rs = dispatch pn f rs-lane pn vim 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 $ vimMarker vim ++ mkHeader (Just i) f-                     dispatch pn f [r]--vimMarker :: Bool -> String-vimMarker False = ""-vimMarker True  = "VIM "---- | 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 precFlag orig =-     case (precFlag, 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 precFlag 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 
@@ -1,176 +0,0 @@------------------------------------------------------------------------------- |--- 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 
@@ -1,3 +0,0 @@-The crackNum library can be installed simply by issuing cabal install like this:--     cabal install crackNum
LICENSE view
@@ -1,6 +1,6 @@-crackIEEE754: Cracking various Floating/Integer values+crackNum: Cracking various Floating/Integer values -Copyright (c) 2015-2016, Levent Erkok (erkokl@gmail.com)+Copyright (c) 2015-2021, Levent Erkok (erkokl@gmail.com) All rights reserved.  Redistribution and use in source and binary forms, with or without
README.md view
@@ -1,99 +1,99 @@-## CrackNum: Decode/Encode IEE754 Numbers+## Decode/Encode Integers, Words, and IEE754 Floats  [![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) -CrackNum now comes with vim bindings, see http://github.com/LeventErkok/crackNum/blob/master/crackNum.vim--### Command line options:+```+Usage: crackNum value OR binary/hex-pattern+  -i N               Signed   integer of N-bits+  -w N               Unsigned integer of N-bits+  -f fp              Floating point format fp+  -r rm              Rounding mode to use. If not given, Nearest-ties-to-Even.+  -h, -?  --help     print help, with examples+  -v      --version  print version info -    crackNum v2.3, (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-              --vim       output in vim friendly format-      -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)-            - You can enter a number in hexadecimal notation (like 0x1.abcp+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+Examples:+ Encoding:+   crackNum -i4   -- -2              -- encode as 4-bit signed integer+   crackNum -w4   2                  -- encode as 4-bit unsigned integer+   crackNum -f3+4 2.5                -- encode as float with 3 bits exponent, 4 bits significand+   crackNum -f3+4 2.5 -rRTZ          -- encode as above, but use RTZ rounding mode.+   crackNum -fbp  2.5                -- encode as a brain-precision float+   crackNum -fdp  2.5                -- encode as a double-precision float -### Example: Decoding single-precision numbers on two lanes+ Decoding:+   crackNum -i4   0b0110             -- decode as 4-bit signed integer, from binary+   crackNum -w4   0xE                -- decode as 4-bit unsigned integer, from hex+   crackNum -f3+4 0b0111001          -- decode as float with 3 bits exponent, 4 bits significand+   crackNum -fbp  0x000F             -- decode as a brain-precision float+   crackNum -fdp  0x8000000000000000 -- decode as a double-precision float -    $ 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)-           Hex-float: -0x1.015782p121-               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)-           Hex-float: NaN (Signaling)-               Value: NaN (Signaling)-                Note: Representation for NaN's is not unique.+ Notes:+   - For encoding:+       - Use -- to separate your argument if it's a negative number.+       - For floats: You can pass in NaN, Inf, -0, -Inf etc as the argument, along with a decimal float.+   - For decoding:+       - Use hexadecimal (0x) or binary (0b) as input. Input must have one of these prefixes.+       - You can use _,- or space as a digit to improve readability for the pattern to be decoded+``` -### Example: Encoding a float as a IEEE754 single-precision bit-pattern+VIM users: You can use the https://github.com/LeventErkok/crackNum/blob/master/crackNum.vim file to+use CrackNum directly from VIM. Simply locate your cursor on the text to crack, and use the+command `:CrackNum options`. -    $ crackNum --sp --toIEEE=-2.3e6+### Example: Encode a decimal numer as a single-precision IEEE754 number+```+$ crackNum -fsp -- -2.3e6+Satisfiable. Model:+  ENCODED = -2300000.0 :: Float                   3  2          1         0                   1 09876543 21098765432109876543210-                  S ---E8--- ----------F23-----------          Binary: 1 10010100 00011000110000110000000-             Hex: CA0C 6180-       Precision: SP+                  S ---E8--- ----------S23----------+   Binary layout: 1 10010100 00011000110000110000000+      Hex layout: CA0C 6180+       Precision: Single             Sign: Negative         Exponent: 21 (Stored: 148, Bias: 127)-       Hex-float: -0x1.18c3p21-           Value: -2300000.0 (NORMAL)+  Classification: FP_NORMAL+          Binary: -0b1.0001100011000011p+21+           Octal: -0o1.061414p+21+         Decimal: -2300000.0+             Hex: -0x2.3186p+20+   Rounding mode: RNE: Round nearest ties to even.+```++### Example: Decode a double-precision IEEE754 number from memory-layout+```+$ crackNum -fdp 0xfc00 abc1 7F80 0001+Satisfiable. Model:+  DECODED = -2.0307920360962302e289 :: Double+                  6    5          4         3         2         1         0+                  3 21098765432 1098765432109876543210987654321098765432109876543210+                  S ----E11---- ------------------------S52-------------------------+   Binary layout: 1 11111000000 0000101010111100000101111111100000000000000000000001+      Hex layout: FC00 ABC1 7F80 0001+       Precision: Double+            Sign: Negative+        Exponent: 961 (Stored: 1984, Bias: 1023)+  Classification: FP_NORMAL+          Binary: -0b1.0000101010111100000101111111100000000000000000000001p+961+           Octal: -0o2.05274057740000001p+960+         Decimal: -2.0307920360962302e289+             Hex: -0x2.15782FF000002p+960+```++### Example: Encode an integer as a 7-bit signed word+```+$ crackNum -i7 12+Satisfiable. Model:+  ENCODED = 12 :: IntN 7+                  654 3210+   Binary layout: 000 1100+      Hex layout: 0C+            Type: Signed 7-bit 2's complement integer+            Sign: Positive+          Binary: 0b1100+           Octal: 0o14+         Decimal: 12+             Hex: 0xc+```
crackNum.cabal view
@@ -1,40 +1,32 @@-Name:                crackNum-Version:             2.4-Synopsis:            Crack various integer, floating-point data formats-Description:         Crack HP, SP and DP floats and 8, 16, 32, 64 bit words and integers.+Cabal-version      : 2.2+Name               : crackNum+Version            : 3.0+Synopsis           : Crack various integer and floating-point data formats+Description        : Crack IEEE-754 float formats and arbitrary sized words and integers, showing the layout.                      .                      For details, please see: <http://github.com/LeventErkok/crackNum/>-License:             BSD3-License-file:        LICENSE-Author:              Levent Erkok-Homepage:            http://github.com/LeventErkok/CrackNum-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, crackNum.vim+License            : BSD-3-Clause+License-file       : LICENSE+Author             : Levent Erkok+Homepage           : http://github.com/LeventErkok/CrackNum+Maintainer         : erkokl@gmail.com+Copyright          : Levent Erkok+Category           : Tools+Build-type         : Simple+Extra-Source-Files : README.md, COPYRIGHT, CHANGES.md -Tested-With       : GHC==8.10.2+Tested-With       : GHC==9.0.1  source-repository head     type:       git     location:   git://github.com/LeventErkok/crackNum.git  Executable crackNum-   main-is      : Data/Numbers/CrackNum/Main.hs-   ghc-options  : -Wall+   main-is         : CrackNum/Main.hs    default-language: Haskell2010-   build-depends: base >= 4.11 && < 5, array, FloatingHex-   other-modules: Data.Numbers.CrackNum-                , Data.Numbers.CrackNum.Utils-                , Data.Numbers.CrackNum.Data-                , Paths_crackNum--Library-  ghc-options     : -Wall-  default-language: Haskell2010-  Build-Depends   : base >= 4 && < 5, array >= 0.4.0.1, FloatingHex >= 0.4-  Exposed-modules : Data.Numbers.CrackNum-  other-modules   : Data.Numbers.CrackNum.Utils-                  , Data.Numbers.CrackNum.Data+   hs-source-dirs  : src+   ghc-options     : -Wall -Wunused-packages+   build-depends   : base >= 4.11 && < 5, libBF, sbv >= 8.14+                   , tasty, tasty-golden, filepath, directory, process+   other-modules   : Paths_crackNum, CrackNum.TestSuite+   autogen-modules : Paths_crackNum
− crackNum.vim 
@@ -1,80 +0,0 @@-""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""-" VI interface to crackNum-"-" Copyright   :  (c) Levent Erkok-" License     :  BSD3-" Maintainer  :  erkokl@gmail.com-"-" INSTALLATION: Put this file in a convenient location (typically your .vim directory),-" and put "so crackNum.vim" in your .vimrc file. (With the appropriate path.)-"-" Once you restart vim, locate your cursor over a stream of binary/hex digits, and-" enter the command :CrackNum to see further options.-"-" See https://github.com/LeventErkok/CrackNum for details.--let g:crackNumPrecisions = ["hp","sp","dp","sb","sw","sd","sq","ub","uw","ud","uq"]-function! CrackNumComplete(A, L, P)-    if empty(a:A)-	return g:crackNumPrecisions-    else-    	let out = filter(copy(g:crackNumPrecisions), 'v:val =~ "^' . a:A . '.*"')-	if empty(out)-	    return g:crackNumPrecisions-	else-	    return out-    endif-endfunction-function! CrackNum(...)-    redraw-    let curWord = expand("<cword>")-    if empty(curWord)-	echoerr "Place the cursor on a bin/hex number to crack!"-	return-    endif-    if empty(a:000)-	echo "Cracking \"" . curWord . "\".. Use TAB to see precisions supported."-	call inputsave()-	let prec = input("Precision> ", "", "customlist,CrackNumComplete")-	call inputrestore()-	let args = [prec] + copy(a:000)-    else-	echo "Cracking \""  . curWord . "\".."-	let prec = a:1-	let args = copy(a:000)-    endif--    if index(g:crackNumPrecisions, prec) < 0-	echoerr "Unknown precision: \"" . prec . "\"" . ". Must be one of: " . join(g:crackNumPrecisions, ' ')-	return-    endif--    let l:grepargs = join(['--vim'] + copy(args) + ['--bv', curWord], ' ')-    let grepprg_bak=&grepprg-    let grepformat_bak=&grepformat-    try-        let &grepprg="crackNum"-        let &grepformat="VIM %m"-        silent execute "grep" . " " . l:grepargs-    finally-        let &grepprg=grepprg_bak-        let &grepformat=grepformat_bak-    endtry--    botright copen--    redraw!-endfunction-command! -nargs=* -complete=customlist,CrackNumComplete CrackNum call CrackNum(<f-args>)-map @nhp   :silent call CrackNum('hp')<CR>-map @nsp   :silent call CrackNum('sp')<CR>-map @ndp   :silent call CrackNum('dp')<CR>-map @nsb   :silent call CrackNum('sb')<CR>-map @nsw   :silent call CrackNum('sw')<CR>-map @nsd   :silent call CrackNum('sd')<CR>-map @nsq   :silent call CrackNum('sq')<CR>-map @nub   :silent call CrackNum('ub')<CR>-map @nuw   :silent call CrackNum('uw')<CR>-map @nud   :silent call CrackNum('ud')<CR>-map @nuq   :silent call CrackNum('uq')<CR>-" end crackNum interface
+ src/CrackNum/Main.hs view
@@ -0,0 +1,382 @@+---------------------------------------------------------------------------+-- |+-- Module      :  Main+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+--+-- Main entry point for the crackNum executable+-----------------------------------------------------------------------------++{-# LANGUAGE CPP                 #-}+{-# LANGUAGE ScopedTypeVariables #-}++{-# OPTIONS_GHC -Wall -Werror #-}++module Main(main) where++import System.Environment (getArgs, getProgName, withArgs)+import Data.Char (isDigit, isSpace, toLower)+import Data.List (isPrefixOf, isSuffixOf, unfoldr)++import System.Console.GetOpt (ArgOrder(Permute), getOpt, ArgDescr(..), OptDescr(..), usageInfo)+import System.Exit           (exitFailure)+import Text.Read             (readMaybe)++import System.IO (hPutStr, stderr)++import LibBF+import Numeric++import Data.SBV           hiding (crack)+import Data.SBV.Float     hiding (FP)+import Data.SBV.Dynamic   hiding (satWith)+import Data.SBV.Internals hiding (free)++import Data.Version    (showVersion)+import Paths_crackNum  (version)++import CrackNum.TestSuite++-- | Copyright info+copyRight :: String+copyRight = "(c) Levent Erkok. Released with a BSD3 license."++-- | Various precisions we support+data FP = SP          -- Single precision+        | DP          -- Double precision+        | FP Int Int  -- Arbitrary precision with given exponent and significand sizes+        deriving (Show, Eq)++-- | How many bits does this float occupy+fpSize :: FP -> Int+fpSize SP       = 32+fpSize DP       = 64+fpSize (FP i j) = i+j++-- | Rounding modes we support+data RM = RNE  -- ^ Round nearest ties to even+        | RNA  -- ^ Round nearest ties to away+        | RTP  -- ^ Round towards positive infinity+        | RTN  -- ^ Round towards negative infinity+        | RTZ  -- ^ Round towards zero+        deriving (Eq, Enum, Bounded)++-- | Show instance for RM, for descriptive purposes+instance Show RM where+  show RNE = "RNE: Round nearest ties to even."+  show RNA = "RNA: Round nearest ties to away."+  show RTP = "RTP: Round towards positive infinity."+  show RTN = "RTN: Round towards negative infinity."+  show RTZ = "RTZ: Round towards zero."++-- Covert to LibBF rounding mode+toLibBFRM :: RM -> RoundMode+toLibBFRM RNE = NearEven+toLibBFRM RNA = NearAway+toLibBFRM RTP = ToPosInf+toLibBFRM RTN = ToNegInf+toLibBFRM RTZ = ToZero++-- | Options accepted by the executable+data Flag = Signed   Int       -- ^ Crack as a signed    word with the given number of bits+          | Unsigned Int       -- ^ Crack as an unsigned word with the given number of bits+          | Floating FP        -- ^ Crack as the corresponding floating-point type+          | RMode    RM        -- ^ Rounding mode to use+          | BadFlag  [String]  -- ^ Bad input+          | Version            -- ^ Version+          | Help               -- ^ Show help+          deriving (Show, Eq)++-- | Is this a rounding flag?+isRMode :: Flag -> Bool+isRMode RMode{} = True+isRMode _       = False++-- | Given an integer flag value, turn it into a flag+getSize :: String -> (Int -> Flag) -> String -> Flag+getSize flg f n = case readMaybe n of+                    Just i | i > 0 -> f i+                           | True  -> BadFlag ["Option " ++ show flg ++ " requires an integer >= 1. Received: " ++ show n]+                    Nothing        -> BadFlag ["Option " ++ show flg ++ " requires an integer argument. Received: " ++ show n]++#include "MachDeps.h"++#define FP_MIN_EB 2+#define FP_MIN_SB 2+#if WORD_SIZE_IN_BITS == 64+#define FP_MAX_EB 61+#define FP_MAX_SB 4611686018427387902+#else+#define FP_MAX_EB 29+#define FP_MAX_SB 1073741822+#endif++-- | Given a float flag value, turn it into a flag+getFP :: String -> Flag+getFP "hp" = Floating $ FP 5 11+getFP "bp" = Floating $ FP 8  8+getFP "sp" = Floating SP+getFP "dp" = Floating DP+getFP "qp" = Floating $ FP 15 113+getFP ab   = case span isDigit ab of+                (eb@(_:_), '+':r) -> case span isDigit r of+                                      (sp@(_:_), "") -> mkEBSB (read eb) (read sp)+                                      _              -> bad+                _                 -> bad+              where bad = BadFlag [ "Option " ++ show "-f" ++ " requires one of:"+                                  , ""+                                  , "    hp: Half float          ( 5 +  11)"+                                  , "    bp: Brain float         ( 8 +   8)"+                                  , "    sp: Single precision    ( 8 +  24)"+                                  , "    dp: Single precision    (11 +  53)"+                                  , "    qp: Quad   precision    (15 + 113)"+                                  , "   a+b: Arbitrary precision ( a +   b)"+                                  , ""+                                  , "where first number is the number of bits in the exponent"+                                  , "and the second number is the number of bits in the significand, including the implicit bit."+                                  ]+                    mkEBSB :: Int -> Int -> Flag+                    mkEBSB eb sb+                     |    eb >= FP_MIN_EB && eb <= FP_MAX_EB+                       && sb >= FP_MIN_SB && sb <= FP_MAX_SB+                     = Floating $ FP eb sb+                     | True+                     = BadFlag [ "Invalid floating-point precision."+                               , ""+                               , "  Exponent    size must be between " ++ show (FP_MIN_EB :: Int) ++ " to "  ++ show (FP_MAX_EB :: Int)+                               , "  Significant size must be between " ++ show (FP_MIN_SB :: Int) ++ " to "  ++ show (FP_MAX_SB :: Int)+                               , ""+                               , "Received: " ++ show eb ++ " " ++ show sb+                               ]++getRM :: String -> Flag+getRM "rne" = RMode RNE+getRM "rna" = RMode RNA+getRM "rtp" = RMode RTP+getRM "rtn" = RMode RTN+getRM "rtz" = RMode RTZ+getRM m     = BadFlag $  [ "Invalid rounding mode."+                         , ""+                         , "  Must be one of:"+                         ]+                      ++ [ "     " ++ show r | r <- [minBound .. maxBound::RM]]+                      ++ [ ""+                         , "Received: " ++ m+                         ]++-- | Options we accept+pgmOptions :: [OptDescr Flag]+pgmOptions = [+      Option "i"  []          (ReqArg (getSize "-i" Signed)   "N" )  "Signed   integer of N-bits"+    , Option "w"  []          (ReqArg (getSize "-w" Unsigned) "N" )  "Unsigned integer of N-bits"+    , Option "f"  []          (ReqArg getFP                   "fp")  "Floating point format fp"+    , Option "r"  []          (ReqArg (getRM . map toLower)   "rm")  "Rounding mode to use. If not given, Nearest-ties-to-Even."+    , Option "h?" ["help"]    (NoArg Help)                           "print help, with examples"+    , Option "v"  ["version"] (NoArg Version)                        "print version info"+    ]++-- | Help info+helpStr :: String -> String+helpStr pn = usageInfo ("Usage: " ++ pn ++ " value OR binary/hex-pattern") pgmOptions++-- | Print usage info and examples.+usage :: String -> IO ()+usage pn = putStr $ unlines [ helpStr pn+                            , "Examples:"+                            , " Encoding:"+                            , "   " ++ pn ++ " -i4   -- -2              -- encode as 4-bit signed integer"+                            , "   " ++ pn ++ " -w4   2                  -- encode as 4-bit unsigned integer"+                            , "   " ++ pn ++ " -f3+4 2.5                -- encode as float with 3 bits exponent, 4 bits significand"+                            , "   " ++ pn ++ " -f3+4 2.5 -rRTZ          -- encode as above, but use RTZ rounding mode."+                            , "   " ++ pn ++ " -fbp  2.5                -- encode as a brain-precision float"+                            , "   " ++ pn ++ " -fdp  2.5                -- encode as a double-precision float"+                            , ""+                            , " Decoding:"+                            , "   " ++ pn ++ " -i4   0b0110             -- decode as 4-bit signed integer, from binary"+                            , "   " ++ pn ++ " -w4   0xE                -- decode as 4-bit unsigned integer, from hex"+                            , "   " ++ pn ++ " -f3+4 0b0111001          -- decode as float with 3 bits exponent, 4 bits significand"+                            , "   " ++ pn ++ " -fbp  0x000F             -- decode as a brain-precision float"+                            , "   " ++ pn ++ " -fdp  0x8000000000000000 -- decode as a double-precision float"+                            , ""+                            , " Notes:"+                            , "   - For encoding:"+                            , "       - Use -- to separate your argument if it's a negative number."+                            , "       - For floats: You can pass in NaN, Inf, -0, -Inf etc as the argument, along with a decimal float."+                            , "   - For decoding:"+                            , "       - Use hexadecimal (0x) or binary (0b) as input. Input must have one of these prefixes."+                            , "       - You can use _,- or space as a digit to improve readability for the pattern to be decoded"+                            ]++-- | Terminate early+die :: [String] -> IO a+die xs = do hPutStr stderr $ unlines $ "ERROR:" : map ("  " ++) xs+            exitFailure++-- | main entry point to crackNum+crack :: String -> [String] -> IO ()+crack pn argv = case getOpt Permute pgmOptions argv of+                  (_,  _,  errs@(_:_)) -> die $ errs ++ lines (helpStr pn)+                  (os, rs, [])+                    | Version `elem` os -> putStrLn $ pn ++ " v" ++ showVersion version ++ ", " ++ copyRight+                    | Help    `elem` os -> usage pn+                    | True              -> do let rm = case reverse [r | RMode r <- os] of+                                                         (r:_) -> r+                                                         _     -> RNE++                                                  arg = dropWhile isSpace $ unwords rs++                                              case ([b | BadFlag b <- os], filter (not . isRMode) os) of+                                                (e:_,  _) -> die e+                                                (_,  [Signed   n]) -> process (SInt   n) rm arg+                                                (_,  [Unsigned n]) -> process (SWord  n) rm arg+                                                (_,  [Floating s]) -> process (SFloat s) rm arg+                                                _                  -> usage pn++-- | Kinds of numbers we understand+data NKind = SInt   Int -- ^ Signed   integer of n bits+           | SWord  Int -- ^ Unsigned integer of n bits+           | SFloat FP  -- ^ Floating point with precision++-- | main entry point to crackNum+main :: IO ()+main = do argv <- getArgs+          pn   <- getProgName++          let rt = "--runTests"++          if rt `elem` argv+             then withArgs (filter (`notElem` [rt, "--"]) argv) runTests+             else crack pn argv++-- | Perform the encoding/decoding+process :: NKind -> RM -> String -> IO ()+process num rm inp = case num of+                       SInt   n -> print =<< (if decode then di else ei) True  n+                       SWord  n -> print =<< (if decode then di else ei) False n+                       SFloat s -> (if decode then df else ef) s+  where decode = any (`isPrefixOf` inp) ["0x", "0b"]++        bitString n = do let isSkippable c = c `elem` "_-" || isSpace c++                         (isHex, stream) <- case map toLower (filter (not . isSkippable) inp) of+                                              '0':'x':rest -> pure (True,  rest)+                                              '0':'b':rest -> pure (False, rest)+                                              _            -> die [ "Input string must start with 0b or 0x for decoding."+                                                                  , "Received prefix: " ++ show (take 2 inp)+                                                                  ]++                         let cvtBin '1' = pure [True]+                             cvtBin '0' = pure [False]+                             cvtBin c   = die  ["Input has a non-binary digit: " ++ show c]++                             cvtHex c = case readHex [c] of+                                          [(v, "")] -> pure $ pad+                                                            $ map (== (1::Int))+                                                            $ reverse+                                                            $ unfoldr (\x -> if x == 0 then Nothing else Just (x `rem` 2, x `div` 2)) v+                                          _         -> die ["Input has a non-hexadecimal digit: " ++ show c]+                                where pad p = replicate (4 - length p) False ++ p++                             cvt i | isHex = concat <$> mapM cvtHex i+                                   | True  = concat <$> mapM cvtBin i++                         encoded <- cvt stream++                         let bits 1 = "one bit"+                             bits b = show b ++ " bits"++                         case length encoded `compare` n of+                           EQ -> pure encoded+                           LT -> die ["Input needs to be " ++ show n ++ " bits wide, it's too short by " ++ bits (n - length encoded)]+                           GT -> die ["Input needs to be " ++ show n ++ " bits wide, it's too long by "  ++ bits (length encoded - n)]++        di :: Bool -> Int -> IO SatResult+        di sgn n = do bs <- bitString n+                      satWith z3{crackNum=True} $ p bs+             where p :: [Bool] -> Goal+                   p bs = do x <- (if sgn then sIntN else sWordN) n "DECODED"+                             mapM_ constrain $ zipWith (.==) (map SBV (svBlastBE x)) (map literal bs)++        ei :: Bool -> Int -> IO SatResult+        ei sgn n = case reads inp of+                     [(v :: Integer, "")] -> satWith z3{crackNum=True} $ p v+                     _                    -> die ["Expected an integer value to decode, received: " ++ show inp]+          where p :: Integer -> Predicate+                p iv = do let k = KBounded sgn n+                              v = SBV $ SVal k $ Left $ mkConstCV k iv+                          x <- (if sgn then sIntN else sWordN) n "ENCODED"+                          pure $ SBV x .== v++        df :: FP -> IO ()+        df fp = do bs <- map literal <$> bitString (fpSize fp)+                   case fp of+                     SP     -> print =<< satWith z3{crackNum=True} (dFloat  bs)+                     DP     -> print =<< satWith z3{crackNum=True} (dDouble bs)+                     FP i j -> print =<< satWith z3{crackNum=True} (dFP i j bs)++        dFloat :: [SBool] -> Goal+        dFloat  bs = do x <- sFloat "DECODED"+                        let (s, e, m) = blastSFloat x+                        mapM_ constrain $ zipWith (.==) (s : e ++ m) bs++        dDouble :: [SBool] -> Goal+        dDouble bs = do x <- sDouble "DECODED"+                        let (s, e, m) = blastSDouble x+                        mapM_ constrain $ zipWith (.==) (s : e ++ m) bs++        dFP :: Int -> Int -> [SBool] -> Goal+        dFP i j bs = do sx <- svNewVar (KFP i j) "DECODED"+                        let bits = svBlastBE sx+                        mapM_ constrain $ zipWith (.==) (map SBV bits) bs++        convert :: Int -> Int -> (BigFloat, Maybe String)+        convert i j = case s of+                        Ok -> (v, Nothing)+                        _  -> (v, Just (trim (show s)))+          where bfOpts = allowSubnormal <> rnd (toLibBFRM rm) <> expBits (fromIntegral i) <> precBits (fromIntegral j)+                (v, s) = bfFromString 10 bfOpts inp+                trim xs | "[" `isPrefixOf` xs && "]" `isSuffixOf` xs = init (tail xs)+                        | True                                       = xs++        note :: Maybe String -> IO ()+        note mbs = do putStrLn $ "   Rounding mode: " ++ show rm+                      case mbs of+                        Nothing -> pure ()+                        Just s  -> putStrLn $ "            Note: Conversion from " ++ show inp ++ " was not faithful. Status: " ++ s ++ "."++        ef :: FP -> IO ()+        ef SP = case reads (fixup inp) of+                  [(v :: Float, "")] -> do print =<< satWith z3{crackNum=True} (p v)+                                           note $ snd $ convert 8 24+                  _                  -> ef (FP 8 24)+         where p :: Float -> Predicate+               p f = do x <- sFloat "ENCODED"+                        pure $ x .=== literal f++        ef DP = case reads (fixup inp) of+                  [(v :: Double, "")] -> do print =<< satWith z3{crackNum=True} (p v)+                                            note $ snd $ convert 11 53+                  _                   -> ef (FP 11 53)+         where p :: Double -> Predicate+               p d = do x <- sDouble"ENCODED"+                        pure $ x .=== literal d++        ef (FP i j) = do let (v, mbS) = convert i j+                         print =<< satWith z3{crackNum=True} (p v)+                         note mbS+          where p :: BigFloat -> Predicate+                p bf = do let k = KFP i j+                          sx <- svNewVar k "ENCODED"+                          pure $ SBV $ sx `svStrongEqual` SVal k (Left (CV k (CFP (fpFromBigFloat i j bf))))++-- | Convert certain strings to more understandable format by read+fixup :: String -> String+fixup inp+ | linp `elem` ["inf",  "infinity"]  = "Infinity"+ | linp `elem` ["-inf", "-infinity"] = "-Infinity"+ | linp == "nan"                     = "NaN"+ | linp == "-nan"                    = "-NaN"+ | True                              = inp+ where linp = map toLower inp
+ src/CrackNum/TestSuite.hs view
@@ -0,0 +1,71 @@+---------------------------------------------------------------------------+-- |+-- Module      :  TestSuite+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+--+-- Test-suite for crackNum+-----------------------------------------------------------------------------++{-# LANGUAGE ScopedTypeVariables #-}++{-# OPTIONS_GHC -Wall -Werror #-}++module CrackNum.TestSuite(runTests) where++import Control.Exception as C++import Test.Tasty+import Test.Tasty.Golden (goldenVsFileDiff)+import System.FilePath++import System.Directory (removeFile)+import System.Process (readProcessWithExitCode)++import Data.List (intercalate)++gold :: TestName -> [String] -> TestTree+gold n args = goldenVsFileDiff n diff gf gfTmp (rm gfTmp >> run)+  where gf    = "Golds" </> n <.> "gold"+        gfTmp = gf ++ "_temp"++        rm f  = removeFile f `C.catch` (\(_ :: C.SomeException) -> return ())++        as  = unwords args+        run = do (ec, so, se) <- readProcessWithExitCode "crackNum" args ""+                 writeFile gfTmp $ intercalate "\n" $ [ "Arguments: " ++ as+                                                      , "Exit code: " ++ show ec+                                                      , so+                                                      ]+                                                      ++ concat [["STDERR:", se] | not (null se)]++        diff ref new = ["diff", "-w", "-u", ref, new]++-- | run the test suite+runTests :: IO ()+runTests = defaultMain tests++tests :: TestTree+tests = testGroup "CrackNum" [+            testGroup "Encode" [+               gold "encode0" ["-i4", "--", "-2"]+             , gold "encode1" ["-w4", "2"]+             , gold "encode2" ["-f3+4", "2.5"]+             , gold "encode3" ["-f3+4", "2.5", "-rRTZ"]+             , gold "encode4" ["-fbp", "2.5"]+             , gold "encode5" ["-fdp", "2.5"]+            ]+          , testGroup "Decode" [+               gold "decode0" ["-i4",   "0b0110"]+            ,  gold "decode1" ["-w4",   "0xE"]+            ,  gold "decode2" ["-f3+4", "0b0111001"]+            ,  gold "decode3" ["-fbp",  "0x000F"]+            ,  gold "decode4" ["-fdp",  "0x8000000000000000"]+            ]+          , testGroup "Bad" [+               gold "badInvocation0" ["-f3+4", "0b01"]+            ,  gold "badInvocation1" ["-f3+4", "0xFFFF"]+            ]+        ]