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