1{-# Language PatternSynonyms, CApiFFI, ViewPatterns #-} 2-- | Configuration and results for FP computation. 3module LibBF.Opts 4 ( -- * Options 5 BFOpts(..) 6 , allowSubnormal 7 8 -- ** Presets 9 , float16 10 , float32 11 , float64 12 , float128 13 , float256 14 15 -- ** Precision 16 , precBits 17 , getPrecBits 18 , precBitsMin 19 , precBitsMax 20 , infPrec 21 22 -- ** Exponent Size 23 , expBits 24 , getExpBits 25 , expBitsMin 26 , expBitsMax 27 28 -- ** Rounding mode 29 , rnd 30 , RoundMode(..) 31 , pattern NearEven 32 , pattern ToZero 33 , pattern ToNegInf 34 , pattern ToPosInf 35 , pattern NearAway 36 , pattern Away 37 , pattern Faithful 38 39 40 -- ** Pretty printing options 41 , ShowFmt(..) 42 , showRnd 43 , showFixed 44 , showFrac 45 , showFree 46 , showFreeMin 47 , addPrefix 48 , forceExp 49 , radixMax 50 51 -- * Status 52 , Status(..) 53 , pattern Ok 54 , pattern InvalidOp 55 , pattern DivideByZero 56 , pattern Overflow 57 , pattern Underflow 58 , pattern Inexact 59 , pattern MemError 60 61 -- * Internal 62 , LimbT 63 , SLimbT 64 , FlagsT 65 ) 66 where 67 68import Data.Word 69import Data.Int 70import Foreign.C.Types 71import Data.Bits 72import Data.List 73#include <libbf.h> 74 75-- | Internal: type for limbs 76type LimbT = #{type limb_t} 77 78-- | Internal: type for signed limbs 79type SLimbT = #{type slimb_t} 80 81-- | Internal: type for flags 82type FlagsT = #{type bf_flags_t} 83 84-- | Specifies various computation settings, combined with 'Semigroup'. 85data BFOpts = BFOpts !LimbT !FlagsT 86 87instance Semigroup BFOpts where 88 BFOpts l f <> BFOpts l1 f1 = BFOpts (max l l1) (f .|. f1) 89 90 91-- | Use infinite precision. This should be used with caution, 92-- as it could exhause memory, and at the moment the library 93-- does not handle this gracefully at all (core dumps). 94infPrec :: BFOpts 95infPrec = BFOpts #{const BF_PREC_INF} 0 96 97-- | Use this many bits to represent the mantissa in the computation. 98-- The input should be in the interval defined by 'precMin' and 'precMax' 99precBits :: Word -> BFOpts 100precBits n = BFOpts (fromIntegral n) 0 101 102-- | Retrieve how many bits to represent the mantissa in the computation. 103getPrecBits :: BFOpts -> Word 104getPrecBits (BFOpts n _) = fromIntegral n 105 106-- | Use the given rounding mode. 107-- If none is specified, then the default is 'NearEven'. 108rnd :: RoundMode -> BFOpts 109rnd (RoundMode r) = BFOpts 0 r 110 111-- | The smallest supported precision (in bits). 112foreign import capi "libbf.h value BF_PREC_MIN" 113 precBitsMin :: Int 114 115-- | The largest supported precision (in bits). 116-- Memory could run out before we run out of precision. 117foreign import capi "libbf.h value BF_PREC_MAX" 118 precBitsMax :: Int 119 120{- | Allow denormalized answers. -} 121allowSubnormal :: BFOpts 122allowSubnormal = BFOpts 0 #{const BF_FLAG_SUBNORMAL} 123 124 125foreign import capi "libbf.h bf_set_exp_bits" 126 bf_set_exp_bits :: CInt -> FlagsT 127 128foreign import capi "libbf.h bf_get_exp_bits" 129 bf_get_exp_bits :: FlagsT -> CInt 130 131-- | Set how many bits to use to represent the exponent. 132-- Should fit in the range defined by 'expBitsMin' and 'expBitsMax'. 133expBits :: Int -> BFOpts 134expBits n = BFOpts 0 (bf_set_exp_bits (fromIntegral n)) 135 136-- | Get the number of exponent bits from a @BFOpts@ value. 137getExpBits :: BFOpts -> Int 138getExpBits (BFOpts _ f) = fromIntegral (bf_get_exp_bits f) 139 140{-| The smallest supported number of bits in the exponent. -} 141foreign import capi "libbf.h value BF_EXP_BITS_MIN" 142 expBitsMin :: Int 143 144{-| The largest number of exponent bits supported. -} 145foreign import capi "libbf.h value BF_EXP_BITS_MAX" 146 expBitsMax :: Int 147 148 149 150-------------------------------------------------------------------------------- 151 152-- | Precision 11, exponent 5 153float16:: RoundMode -> BFOpts 154float16 r = rnd r <> precBits 11 <> expBits 5 155 156-- | Precision 24, exponent 8 157float32 :: RoundMode -> BFOpts 158float32 r = rnd r <> precBits 24 <> expBits 8 159 160-- | Precision 53, exponent 11 161float64 :: RoundMode -> BFOpts 162float64 r = rnd r <> precBits 53 <> expBits 11 163 164-- | Precision 113, exponent 15 165float128 :: RoundMode -> BFOpts 166float128 r = rnd r <> precBits 113 <> expBits 15 167 168-- | Precision 237, exponent 19 169float256 :: RoundMode -> BFOpts 170float256 r = rnd r <> precBits 237 <> expBits 19 171 172 173-------------------------------------------------------------------------------- 174 175-- | Settings for rendering numbers as 'String'. 176data ShowFmt = ShowFmt !LimbT !FlagsT 177 178-- | Use this rounding mode. 179showRnd :: RoundMode -> ShowFmt 180showRnd (RoundMode r) = ShowFmt 1 r 181 182instance Semigroup ShowFmt where 183 ShowFmt a x <> ShowFmt b y = ShowFmt (max a b) (x .|. y) 184 185{-| Show this many significant digits total . -} 186showFixed :: Word -> ShowFmt 187showFixed n = ShowFmt (fromIntegral n) #{const BF_FTOA_FORMAT_FIXED} 188 189{-| Show this many digits after the decimal point. -} 190showFrac :: Word -> ShowFmt 191showFrac n = ShowFmt (fromIntegral n) #{const BF_FTOA_FORMAT_FRAC} 192 193{-| Use as many digits as necessary to match the required precision 194 rounding to nearest and the subnormal+exponent configuration of 'FlagsT'. 195 The result is meaningful only if the input is already rounded to 196 the wanted precision. 197 198 Infinite precision, indicated by giving 'Nothing' for the precision 199 is supported when the radix is a power of two. -} 200showFree :: Maybe Word -> ShowFmt 201showFree mb = ShowFmt prec #{const BF_FTOA_FORMAT_FREE} 202 where prec = case mb of 203 Nothing -> #{const BF_PREC_INF} 204 Just n -> fromIntegral n 205 206 207{-| same as 'showFree' but uses the minimum number of digits 208(takes more computation time). -} 209showFreeMin :: Maybe Word -> ShowFmt 210showFreeMin mb = ShowFmt prec #{const BF_FTOA_FORMAT_FREE_MIN} 211 where prec = case mb of 212 Nothing -> #{const BF_PREC_INF} 213 Just n -> fromIntegral n 214 215 216 217{- | add 0x prefix for base 16, 0o prefix for base 8 or 0b prefix for 218 base 2 if non zero value -} 219addPrefix :: ShowFmt 220addPrefix = ShowFmt 0 #{const BF_FTOA_ADD_PREFIX} 221 222-- | Show in exponential form. 223forceExp :: ShowFmt 224forceExp = ShowFmt 0 #{const BF_FTOA_FORCE_EXP} 225 226 227-- | Maximum radix when rendering to a for @bf_atof@ and @bf_froa@. 228foreign import capi "libbf.h value BF_RADIX_MAX" 229 radixMax :: Int 230 231 232 233 234 235-------------------------------------------------------------------------------- 236-- | Specifies how to round when the result can't be precise. 237newtype RoundMode = RoundMode FlagsT 238 deriving Show 239 240{-| Round to nearest, ties go to even. -} 241pattern NearEven :: RoundMode 242pattern NearEven = RoundMode #{const BF_RNDN} 243 244{-| Round toward zero. -} 245pattern ToZero :: RoundMode 246pattern ToZero = RoundMode #{const BF_RNDZ} 247 248{-| Round down (toward -inf). -} 249pattern ToNegInf :: RoundMode 250pattern ToNegInf = RoundMode #{const BF_RNDD} 251 252{-| Round up (toward +inf). -} 253pattern ToPosInf :: RoundMode 254pattern ToPosInf = RoundMode #{const BF_RNDU} 255 256{-| Round to nearest, ties go away from zero. -} 257pattern NearAway :: RoundMode 258pattern NearAway = RoundMode #{const BF_RNDNA} 259 260{-| Round away from zero -} 261pattern Away :: RoundMode 262pattern Away = RoundMode #{const BF_RNDA} 263 264{-| Faithful rounding (nondeterministic, either 'ToPosInf' or 'ToNegInf'). 265 The 'Inexact' flag is always set. -} 266pattern Faithful :: RoundMode 267pattern Faithful = RoundMode #{const BF_RNDF} 268 269 270-------------------------------------------------------------------------------- 271 272-- | A set of flags indicating things that might go wrong. 273newtype Status = Status CInt deriving (Eq,Ord) 274 275instance Semigroup Status where 276 Status a <> Status b = Status (a .|. b) 277 278instance Monoid Status where 279 mempty = Ok 280 mappend = (<>) 281 282checkStatus :: CInt -> Status -> Bool 283checkStatus n (Status x) = (x .&. n) > 0 284 285-- | Succeeds if everything is OK. 286pattern Ok :: Status 287pattern Ok = Status 0 288 289-- | We tried to perform an invalid operation. 290pattern InvalidOp :: Status 291pattern InvalidOp <- (checkStatus #{const BF_ST_INVALID_OP} -> True) 292 where InvalidOp = Status #{const BF_ST_INVALID_OP} 293 294-- | We divided by zero. 295pattern DivideByZero :: Status 296pattern DivideByZero <- (checkStatus #{const BF_ST_DIVIDE_ZERO} -> True) 297 where DivideByZero = Status #{const BF_ST_DIVIDE_ZERO} 298 299-- | The result can't be represented because it is too large. 300pattern Overflow :: Status 301pattern Overflow <- (checkStatus #{const BF_ST_OVERFLOW} -> True) 302 where Overflow = Status #{const BF_ST_OVERFLOW} 303 304-- | The result can't be represented because it is too small. 305pattern Underflow :: Status 306pattern Underflow <- (checkStatus #{const BF_ST_UNDERFLOW} -> True) 307 where Underflow = Status #{const BF_ST_UNDERFLOW} 308 309-- | The result is not exact. 310pattern Inexact :: Status 311pattern Inexact <- (checkStatus #{const BF_ST_INEXACT} -> True) 312 where Inexact = Status #{const BF_ST_INEXACT} 313 314-- | Memory error. @NaN@ is returned. 315pattern MemError :: Status 316pattern MemError <- (checkStatus #{const BF_ST_MEM_ERROR} -> True) 317 where MemError = Status #{const BF_ST_MEM_ERROR} 318 319instance Show Status where 320 show x@(Status i) = case x of 321 Ok -> "Ok" 322 _ -> case checkInv of 323 [] -> "(Status " ++ show i ++ ")" 324 xs -> "[" ++ intercalate "," xs ++ "]" 325 where 326 checkInv = case x of 327 InvalidOp -> "InvalidOp" : checkZ 328 _ -> checkZ 329 330 checkZ = case x of 331 DivideByZero -> "DivideByZero" : checkO 332 _ -> checkO 333 334 checkO = case x of 335 Overflow -> "Overflow" : checkU 336 _ -> checkU 337 338 checkU = case x of 339 Underflow -> "Underflow" : checkI 340 _ -> checkI 341 342 checkI = case x of 343 Inexact -> "Inexact" : checkM 344 _ -> checkM 345 346 checkM = case x of 347 MemError -> ["MemError"] 348 _ -> [] 349 350 351