deka 0.2.0.2 → 0.4.0.0
raw patch · 5 files changed
+789/−265 lines, 5 filesdep −bindings-DSL
Dependencies removed: bindings-DSL
Files
- ChangeLog +6/−0
- deka.cabal +3/−4
- lib/Data/Deka/Decnumber.hsc +693/−173
- lib/Data/Deka/Internal.hs +85/−0
- lib/Data/Deka/Quad.hs +2/−88
ChangeLog view
@@ -1,3 +1,9 @@+version 0.4.0.0:++* removed bindings-dsl; see comments in git log++* made Quad an instance of Eq and Ord+ version 0.2.0.2: * updated .travis.yml for decnumber dependency
deka.cabal view
@@ -6,7 +6,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.2.0.2+version: 0.4.0.0 synopsis: Decimal floating point arithmetic description:@@ -67,18 +67,17 @@ exposed-modules: Data.Deka- , Data.Deka.Decnumber , Data.Deka.Quad , Data.Deka.Docs , Data.Deka.Docs.Examples other-modules:- Data.Deka.Internal+ Data.Deka.Decnumber+ , Data.Deka.Internal build-depends: base >=4.6 && <4.7 , bytestring ==0.10.*- , bindings-DSL ==1.0.* ghc-options: -Wall default-language: Haskell2010
lib/Data/Deka/Decnumber.hsc view
@@ -1,211 +1,731 @@ {-# LANGUAGE ForeignFunctionInterface #-}--- Bindings-dsl sometimes shadows in do notation--- Bindings-dsl imports unused things -{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-imports #-}--#include <bindings.dsl.h> #include <decContext.h> #include <decQuad.h> +#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)+ -- | Low-level bindings to the decNumber library. module Data.Deka.Decnumber where -#strict_import+import Foreign.Safe+import Foreign.C+import Control.Applicative -#num NULL+c'NULL :: Num a => a+c'NULL = #const NULL -#integral_t enum rounding-#num DEC_ROUND_CEILING-#num DEC_ROUND_UP-#num DEC_ROUND_HALF_UP-#num DEC_ROUND_HALF_EVEN-#num DEC_ROUND_HALF_DOWN-#num DEC_ROUND_DOWN-#num DEC_ROUND_FLOOR-#num DEC_ROUND_05UP-#num DEC_ROUND_MAX+type C'rounding = #type enum rounding -#integral_t int32_t-#integral_t uint8_t-#integral_t uint16_t-#integral_t uint32_t-#integral_t uint64_t+c'DEC_ROUND_CEILING :: Num a => a+c'DEC_ROUND_CEILING = #const DEC_ROUND_CEILING +c'DEC_ROUND_UP :: Num a => a+c'DEC_ROUND_UP = #const DEC_ROUND_UP -#starttype decContext-#field digits , <int32_t>-#field emax , <int32_t>-#field emin , <int32_t>-#field round , <enum rounding>-#field traps , <uint32_t>-#field status , <uint32_t>-#field clamp , <uint8_t>-#stoptype+c'DEC_ROUND_HALF_UP :: Num a => a+c'DEC_ROUND_HALF_UP = #const DEC_ROUND_HALF_UP +c'DEC_ROUND_HALF_EVEN :: Num a => a+c'DEC_ROUND_HALF_EVEN = #const DEC_ROUND_HALF_EVEN++c'DEC_ROUND_HALF_DOWN :: Num a => a+c'DEC_ROUND_HALF_DOWN = #const DEC_ROUND_HALF_DOWN++c'DEC_ROUND_DOWN :: Num a => a+c'DEC_ROUND_DOWN = #const DEC_ROUND_DOWN++c'DEC_ROUND_FLOOR :: Num a => a+c'DEC_ROUND_FLOOR = #const DEC_ROUND_FLOOR++c'DEC_ROUND_05UP :: Num a => a+c'DEC_ROUND_05UP = #const DEC_ROUND_05UP++c'DEC_ROUND_MAX :: Num a => a+c'DEC_ROUND_MAX = #const DEC_ROUND_MAX++type C'int32_t = #type int32_t+type C'uint8_t = #type uint8_t+type C'uint16_t = #type uint16_t+type C'uint32_t = #type uint32_t+type C'uint64_t = #type uint64_t++data C'decContext = C'decContext+ { c'decContext'digits :: C'int32_t+ , c'decContext'emax :: C'int32_t+ , c'decContext'emin :: C'int32_t+ , c'decContext'round :: C'rounding+ , c'decContext'traps :: C'uint32_t+ , c'decContext'status :: C'uint32_t+ , c'decContext'clamp :: C'uint8_t+ } deriving (Eq, Show)++instance Storable C'decContext where+ sizeOf _ = #size decContext+ alignment _ = #alignment decContext+ peek p =+ C'decContext+ <$> #{peek decContext, digits} p+ <*> #{peek decContext, emax} p+ <*> #{peek decContext, emin} p+ <*> #{peek decContext, round} p+ <*> #{peek decContext, traps} p+ <*> #{peek decContext, status} p+ <*> #{peek decContext, clamp} p++ poke p (C'decContext d ex en r t s c) =+ #{poke decContext, digits} p d+ >> #{poke decContext, emax} p ex+ >> #{poke decContext, emin} p en+ >> #{poke decContext, round} p r+ >> #{poke decContext, traps} p t+ >> #{poke decContext, status} p s+ >> #{poke decContext, clamp} p c++p'decContext'status :: Ptr C'decContext -> Ptr C'uint32_t+p'decContext'status = #ptr decContext, status++p'decContext'round :: Ptr C'decContext -> Ptr C'rounding+p'decContext'round = #ptr decContext, round+ -- decContext-#num DEC_INIT_DECQUAD-#ccall_unsafe decContextDefault , Ptr <decContext> -> <int32_t> -> IO (Ptr <decContext>)+c'DEC_INIT_DECQUAD :: Num a => a+c'DEC_INIT_DECQUAD = #const DEC_INIT_DECQUAD -#integral_t enum decClass-#num DEC_CLASS_SNAN-#num DEC_CLASS_QNAN-#num DEC_CLASS_NEG_INF-#num DEC_CLASS_NEG_NORMAL-#num DEC_CLASS_NEG_SUBNORMAL-#num DEC_CLASS_NEG_ZERO-#num DEC_CLASS_POS_ZERO-#num DEC_CLASS_POS_SUBNORMAL-#num DEC_CLASS_POS_NORMAL-#num DEC_CLASS_POS_INF+foreign import ccall unsafe "decContextDefault" unsafe'c'decContextDefault+ :: Ptr C'decContext+ -> C'int32_t+ -> IO (Ptr C'decContext) -#num DEC_Conversion_syntax-#num DEC_Division_by_zero-#num DEC_Division_impossible-#num DEC_Division_undefined-#num DEC_Insufficient_storage-#num DEC_Inexact-#num DEC_Invalid_context-#num DEC_Invalid_operation-#num DEC_Overflow-#num DEC_Clamped-#num DEC_Rounded-#num DEC_Subnormal-#num DEC_Underflow+type C'decClass = #type enum decClass -#num DEC_IEEE_754_Division_by_zero-#num DEC_IEEE_754_Inexact-#num DEC_IEEE_754_Invalid_operation-#num DEC_IEEE_754_Overflow-#num DEC_IEEE_754_Underflow-#num DEC_Errors-#num DEC_NaNs+c'DEC_CLASS_SNAN :: Num a => a+c'DEC_CLASS_SNAN = #const DEC_CLASS_SNAN -#num DEC_Condition_Length+c'DEC_CLASS_QNAN :: Num a => a+c'DEC_CLASS_QNAN = #const DEC_CLASS_QNAN -#num DEC_INIT_BASE-#num DEC_INIT_DECIMAL32-#num DEC_INIT_DECIMAL64-#num DEC_INIT_DECIMAL128+c'DEC_CLASS_NEG_INF :: Num a => a+c'DEC_CLASS_NEG_INF = #const DEC_CLASS_NEG_INF +c'DEC_CLASS_NEG_NORMAL :: Num a => a+c'DEC_CLASS_NEG_NORMAL = #const DEC_CLASS_NEG_NORMAL -#num DECQUAD_Bytes-#num DECQUAD_Pmax-#num DECQUAD_Emin-#num DECQUAD_Emax-#num DECQUAD_EmaxD-#num DECQUAD_Bias-#num DECQUAD_String-#num DECQUAD_EconL-#num DECQUAD_Declets-#num DECQUAD_Ehigh+c'DEC_CLASS_NEG_SUBNORMAL :: Num a => a+c'DEC_CLASS_NEG_SUBNORMAL = #const DEC_CLASS_NEG_SUBNORMAL -#starttype decQuad-#array_field bytes , <uint8_t>-#array_field shorts , <uint16_t>-#array_field words , <uint32_t>-#stoptype+c'DEC_CLASS_NEG_ZERO :: Num a => a+c'DEC_CLASS_NEG_ZERO = #const DEC_CLASS_NEG_ZERO +c'DEC_CLASS_POS_ZERO :: Num a => a+c'DEC_CLASS_POS_ZERO = #const DEC_CLASS_POS_ZERO -#num DECFLOAT_Sign-#num DECFLOAT_NaN-#num DECFLOAT_qNaN-#num DECFLOAT_sNaN-#num DECFLOAT_Inf-#num DECFLOAT_MinSp+c'DEC_CLASS_POS_SUBNORMAL :: Num a => a+c'DEC_CLASS_POS_SUBNORMAL = #const DEC_CLASS_POS_SUBNORMAL -#num DECPPLUSALT-#num DECPMINUSALT-#num DECPPLUS-#num DECPMINUS-#num DECPPLUSALT2-#num DECPUNSIGNED+c'DEC_CLASS_POS_NORMAL :: Num a => a+c'DEC_CLASS_POS_NORMAL = #const DEC_CLASS_POS_NORMAL +c'DEC_CLASS_POS_INF :: Num a => a+c'DEC_CLASS_POS_INF = #const DEC_CLASS_POS_INF++c'DEC_Conversion_syntax :: Num a => a+c'DEC_Conversion_syntax = #const DEC_Conversion_syntax++c'DEC_Division_by_zero :: Num a => a+c'DEC_Division_by_zero = #const DEC_Division_by_zero++c'DEC_Division_impossible :: Num a => a+c'DEC_Division_impossible = #const DEC_Division_impossible++c'DEC_Division_undefined :: Num a => a+c'DEC_Division_undefined = #const DEC_Division_undefined++c'DEC_Insufficient_storage :: Num a => a+c'DEC_Insufficient_storage = #const DEC_Insufficient_storage++c'DEC_Inexact :: Num a => a+c'DEC_Inexact = #const DEC_Inexact++c'DEC_Invalid_context :: Num a => a+c'DEC_Invalid_context = #const DEC_Invalid_context++c'DEC_Invalid_operation :: Num a => a+c'DEC_Invalid_operation = #const DEC_Invalid_operation++c'DEC_Overflow :: Num a => a+c'DEC_Overflow = #const DEC_Overflow++c'DEC_Clamped :: Num a => a+c'DEC_Clamped = #const DEC_Clamped++c'DEC_Rounded :: Num a => a+c'DEC_Rounded = #const DEC_Rounded++c'DEC_Subnormal :: Num a => a+c'DEC_Subnormal = #const DEC_Subnormal++c'DEC_Underflow :: Num a => a+c'DEC_Underflow = #const DEC_Underflow++c'DEC_IEEE_754_Division_by_zero :: Num a => a+c'DEC_IEEE_754_Division_by_zero = #const DEC_IEEE_754_Division_by_zero++c'DEC_IEEE_754_Inexact :: Num a => a+c'DEC_IEEE_754_Inexact = #const DEC_IEEE_754_Inexact++c'DEC_IEEE_754_Invalid_operation :: Num a => a+c'DEC_IEEE_754_Invalid_operation = #const DEC_IEEE_754_Invalid_operation++c'DEC_IEEE_754_Overflow :: Num a => a+c'DEC_IEEE_754_Overflow = #const DEC_IEEE_754_Overflow++c'DEC_IEEE_754_Underflow :: Num a => a+c'DEC_IEEE_754_Underflow = #const DEC_IEEE_754_Underflow++c'DEC_Errors :: Num a => a+c'DEC_Errors = #const DEC_Errors++c'DEC_NaNs :: Num a => a+c'DEC_NaNs = #const DEC_NaNs++c'DEC_Condition_Length :: Num a => a+c'DEC_Condition_Length = #const DEC_Condition_Length++c'DEC_INIT_BASE :: Num a => a+c'DEC_INIT_BASE = #const DEC_INIT_BASE++c'DEC_INIT_DECIMAL32 :: Num a => a+c'DEC_INIT_DECIMAL32 = #const DEC_INIT_DECIMAL32++c'DEC_INIT_DECIMAL64 :: Num a => a+c'DEC_INIT_DECIMAL64 = #const DEC_INIT_DECIMAL64++c'DEC_INIT_DECIMAL128 :: Num a => a+c'DEC_INIT_DECIMAL128 = #const DEC_INIT_DECIMAL128+++c'DECQUAD_Bytes :: Num a => a+c'DECQUAD_Bytes = #const DECQUAD_Bytes++c'DECQUAD_Pmax :: Num a => a+c'DECQUAD_Pmax = #const DECQUAD_Pmax++c'DECQUAD_Emin :: Num a => a+c'DECQUAD_Emin = #const DECQUAD_Emin++c'DECQUAD_Emax :: Num a => a+c'DECQUAD_Emax = #const DECQUAD_Emax++c'DECQUAD_EmaxD :: Num a => a+c'DECQUAD_EmaxD = #const DECQUAD_EmaxD++c'DECQUAD_Bias :: Num a => a+c'DECQUAD_Bias = #const DECQUAD_Bias++c'DECQUAD_String :: Num a => a+c'DECQUAD_String = #const DECQUAD_String++c'DECQUAD_EconL :: Num a => a+c'DECQUAD_EconL = #const DECQUAD_EconL++c'DECQUAD_Declets :: Num a => a+c'DECQUAD_Declets = #const DECQUAD_Declets++c'DECQUAD_Ehigh :: Num a => a+c'DECQUAD_Ehigh = #const DECQUAD_Ehigh++newtype C'decQuad = C'decQuad+ { c'decQuad'bytes :: [C'uint8_t]+ } deriving (Eq, Show)++p'decQuad'bytes :: Ptr C'decQuad -> Ptr c'decQuad'bytes+p'decQuad'bytes = #ptr decQuad, bytes++instance Storable C'decQuad where+ sizeOf _ = #size decQuad+ alignment _ = #alignment decQuad+ peek p =+ let pArr = p'decQuad'bytes p+ in fmap C'decQuad $ peekArray c'DECQUAD_Bytes pArr+ poke p (C'decQuad bs) = pokeArray (p'decQuad'bytes p) bs++c'DECFLOAT_Sign :: Num a => a+c'DECFLOAT_Sign = #const DECFLOAT_Sign++c'DECFLOAT_NaN :: Num a => a+c'DECFLOAT_NaN = #const DECFLOAT_NaN++c'DECFLOAT_qNaN :: Num a => a+c'DECFLOAT_qNaN = #const DECFLOAT_qNaN++c'DECFLOAT_sNaN :: Num a => a+c'DECFLOAT_sNaN = #const DECFLOAT_sNaN++c'DECFLOAT_Inf :: Num a => a+c'DECFLOAT_Inf = #const DECFLOAT_Inf++c'DECFLOAT_MinSp :: Num a => a+c'DECFLOAT_MinSp = #const DECFLOAT_MinSp+++c'DECPPLUSALT :: Num a => a+c'DECPPLUSALT = #const DECPPLUSALT++c'DECPMINUSALT :: Num a => a+c'DECPMINUSALT = #const DECPMINUSALT++c'DECPPLUS :: Num a => a+c'DECPPLUS = #const DECPPLUS++c'DECPMINUS :: Num a => a+c'DECPMINUS = #const DECPMINUS++c'DECPPLUSALT2 :: Num a => a+c'DECPPLUSALT2 = #const DECPPLUSALT2++c'DECPUNSIGNED :: Num a => a+c'DECPUNSIGNED = #const DECPUNSIGNED++ -- Utilities -#ccall_unsafe decQuadToInt32 , Ptr <decQuad> -> Ptr <decContext> -> <enum rounding> -> IO <int32_t>-#ccall_unsafe decQuadToInt32Exact , Ptr <decQuad> -> Ptr <decContext> -> <enum rounding> -> IO <int32_t>+foreign import ccall unsafe "decQuadToInt32" unsafe'c'decQuadToInt32+ :: Ptr C'decQuad+ -> Ptr C'decContext+ -> C'rounding+ -> IO C'int32_t -#ccall_unsafe decQuadFromInt32 , Ptr <decQuad> -> <int32_t> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadFromPacked , Ptr <decQuad> -> <int32_t> -> Ptr <uint8_t> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadFromPackedChecked , Ptr <decQuad> -> <int32_t> -> Ptr <uint8_t> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadFromUInt32 , Ptr <decQuad> -> <uint32_t> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadFromString , Ptr <decQuad> -> CString -> Ptr <decContext> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadGetCoefficient , Ptr <decQuad> -> Ptr <uint8_t> -> IO <int32_t>-#ccall_unsafe decQuadGetExponent , Ptr <decQuad> -> IO <int32_t>-#ccall_unsafe decQuadSetCoefficient , Ptr <decQuad> -> Ptr <uint8_t> -> <int32_t> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadSetExponent , Ptr <decQuad> -> Ptr <decContext> -> <int32_t> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadShow , Ptr <decQuad> -> CString -> IO ()-#ccall_unsafe decQuadToEngString , Ptr <decQuad> -> CString -> IO CString-#ccall_unsafe decQuadToString , Ptr <decQuad> -> CString -> IO CString-#ccall_unsafe decQuadToUInt32 , Ptr <decQuad> -> Ptr <decContext> -> <enum rounding> -> IO <uint32_t>-#ccall_unsafe decQuadToUInt32Exact , Ptr <decQuad> -> Ptr <decContext> -> <enum rounding> -> IO <uint32_t>-#ccall_unsafe decQuadZero , Ptr <decQuad> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadAbs , Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decContext> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadAdd , Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decContext> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadAnd , Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decContext> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadDivide , Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decContext> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadDivideInteger , Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decContext> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadFMA , Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decContext> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadFromBCD , Ptr <decQuad> -> <int32_t> -> Ptr <uint8_t> -> <int32_t> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadInvert , Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decContext> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadLogB , Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decContext> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadMax , Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decContext> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadMaxMag , Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decContext> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadMin , Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decContext> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadMinMag , Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decContext> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadMinus , Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decContext> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadMultiply , Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decContext> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadNextMinus , Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decContext> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadNextPlus , Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decContext> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadNextToward , Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decContext> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadOr , Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decContext> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadPlus , Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decContext> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadQuantize , Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decContext> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadReduce , Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decContext> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadRemainder , Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decContext> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadRemainderNear , Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decContext> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadRotate , Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decContext> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadScaleB , Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decContext> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadShift , Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decContext> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadSubtract , Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decContext> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadToBCD , Ptr <decQuad> -> Ptr <int32_t> -> Ptr <uint8_t> -> IO <int32_t>-#ccall_unsafe decQuadToIntegralValue , Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decContext> -> <enum rounding> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadToIntegralExact , Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decContext> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadXor , Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decContext> -> IO (Ptr <decQuad>)+foreign import ccall unsafe "decQuadToInt32Exact" unsafe'c'decQuadToInt32Exact+ :: Ptr C'decQuad+ -> Ptr C'decContext+ -> C'rounding+ -> IO C'int32_t +foreign import ccall unsafe "decQuadFromInt32" unsafe'c'decQuadFromInt32+ :: Ptr C'decQuad+ -> C'int32_t+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadFromPacked" unsafe'c'decQuadFromPacked+ :: Ptr C'decQuad+ -> C'int32_t+ -> Ptr C'uint8_t+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadFromPackedChecked" unsafe'c'decQuadFromPackedChecked+ :: Ptr C'decQuad+ -> C'int32_t+ -> Ptr C'uint8_t+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadFromUInt32" unsafe'c'decQuadFromUInt32+ :: Ptr C'decQuad+ -> C'uint32_t+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadFromString" unsafe'c'decQuadFromString+ :: Ptr C'decQuad+ -> CString+ -> Ptr C'decContext+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadGetCoefficient" unsafe'c'decQuadGetCoefficient+ :: Ptr C'decQuad+ -> Ptr C'uint8_t+ -> IO C'int32_t++foreign import ccall unsafe "decQuadGetExponent" unsafe'c'decQuadGetExponent+ :: Ptr C'decQuad+ -> IO C'int32_t++foreign import ccall unsafe "decQuadSetCoefficient" unsafe'c'decQuadSetCoefficient+ :: Ptr C'decQuad+ -> Ptr C'uint8_t+ -> C'int32_t+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadSetExponent" unsafe'c'decQuadSetExponent+ :: Ptr C'decQuad+ -> Ptr C'decContext+ -> C'int32_t+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadShow" unsafe'c'decQuadShow+ :: Ptr C'decQuad+ -> CString+ -> IO ()++foreign import ccall unsafe "decQuadToEngString" unsafe'c'decQuadToEngString+ :: Ptr C'decQuad+ -> CString+ -> IO CString++foreign import ccall unsafe "decQuadToString" unsafe'c'decQuadToString+ :: Ptr C'decQuad+ -> CString+ -> IO CString++foreign import ccall unsafe "decQuadToUInt32" unsafe'c'decQuadToUInt32+ :: Ptr C'decQuad+ -> Ptr C'decContext+ -> C'rounding+ -> IO C'uint32_t+++foreign import ccall unsafe "decQuadToUInt32Exact" unsafe'c'decQuadToUInt32Exact+ :: Ptr C'decQuad+ -> Ptr C'decContext+ -> C'rounding+ -> IO C'uint32_t++foreign import ccall unsafe "decQuadZero" unsafe'c'decQuadZero+ :: Ptr C'decQuad+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadAbs" unsafe'c'decQuadAbs+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decContext -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadAdd" unsafe'c'decQuadAdd+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decContext+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadAnd" unsafe'c'decQuadAnd+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decContext+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadDivide" unsafe'c'decQuadDivide+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decContext+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadDivideInteger" unsafe'c'decQuadDivideInteger+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decContext+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadFMA" unsafe'c'decQuadFMA+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decContext+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadFromBCD" unsafe'c'decQuadFromBCD+ :: Ptr C'decQuad+ -> C'int32_t+ -> Ptr C'uint8_t+ -> C'int32_t+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadInvert" unsafe'c'decQuadInvert+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decContext+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadLogB" unsafe'c'decQuadLogB+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decContext+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadMax" unsafe'c'decQuadMax+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decContext+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadMaxMag" unsafe'c'decQuadMaxMag+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decContext+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadMin" unsafe'c'decQuadMin+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decContext+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadMinMag" unsafe'c'decQuadMinMag+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decContext+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadMinus" unsafe'c'decQuadMinus+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decContext+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadMultiply" unsafe'c'decQuadMultiply+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decContext+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadNextMinus" unsafe'c'decQuadNextMinus+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decContext+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadNextPlus" unsafe'c'decQuadNextPlus+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decContext+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadNextToward" unsafe'c'decQuadNextToward+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decContext+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadOr" unsafe'c'decQuadOr+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decContext+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadPlus" unsafe'c'decQuadPlus+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decContext+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadQuantize" unsafe'c'decQuadQuantize+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decContext+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadReduce" unsafe'c'decQuadReduce+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decContext+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadRemainder" unsafe'c'decQuadRemainder+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decContext+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadRemainderNear" unsafe'c'decQuadRemainderNear+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decContext+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadRotate" unsafe'c'decQuadRotate+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decContext+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadScaleB" unsafe'c'decQuadScaleB+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decContext+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadShift" unsafe'c'decQuadShift+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decContext+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadSubtract" unsafe'c'decQuadSubtract+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decContext+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadToBCD" unsafe'c'decQuadToBCD+ :: Ptr C'decQuad+ -> Ptr C'int32_t+ -> Ptr C'uint8_t+ -> IO C'int32_t++foreign import ccall unsafe "decQuadToIntegralValue" unsafe'c'decQuadToIntegralValue+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decContext+ -> C'rounding+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadToIntegralExact" unsafe'c'decQuadToIntegralExact+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decContext+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadXor" unsafe'c'decQuadXor+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decContext+ -> IO (Ptr C'decQuad)+ -- Comparisons -#ccall_unsafe decQuadCompare , Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decContext> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadCompareSignal , Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decContext> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadCompareTotal , Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decQuad> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadCompareTotalMag , Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decQuad> -> IO (Ptr <decQuad>)+foreign import ccall unsafe "decQuadCompare" unsafe'c'decQuadCompare+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decContext+ -> IO (Ptr C'decQuad) +foreign import ccall unsafe "decQuadCompareSignal" unsafe'c'decQuadCompareSignal+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decContext+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadCompareTotal" unsafe'c'decQuadCompareTotal+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decQuad+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadCompareTotalMag" unsafe'c'decQuadCompareTotalMag+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decQuad+ -> IO (Ptr C'decQuad)+ -- Copies-#ccall_unsafe decQuadCanonical , Ptr <decQuad> -> Ptr <decQuad> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadCopyAbs , Ptr <decQuad> -> Ptr <decQuad> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadCopyNegate , Ptr <decQuad> -> Ptr <decQuad> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadCopySign , Ptr <decQuad> -> Ptr <decQuad> -> Ptr <decQuad> -> IO (Ptr <decQuad>)-#ccall_unsafe decQuadCopy , Ptr <decQuad> -> Ptr <decQuad> -> IO (Ptr <decQuad>)+foreign import ccall unsafe "decQuadCanonical" unsafe'c'decQuadCanonical+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> IO (Ptr C'decQuad) +foreign import ccall unsafe "decQuadCopyAbs" unsafe'c'decQuadCopyAbs+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadCopyNegate" unsafe'c'decQuadCopyNegate+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadCopySign" unsafe'c'decQuadCopySign+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decQuad+ -> IO (Ptr C'decQuad)++foreign import ccall unsafe "decQuadCopy" unsafe'c'decQuadCopy+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> IO (Ptr C'decQuad)+ -- Non-computational -#ccall_unsafe decQuadClass , Ptr <decQuad> -> IO <decClass>-#ccall_unsafe decQuadClassString , Ptr <decQuad> -> IO CString-#ccall_unsafe decQuadDigits , Ptr <decQuad> -> IO <uint32_t>-#ccall_unsafe decQuadIsCanonical , Ptr <decQuad> -> IO <uint32_t>-#ccall_unsafe decQuadIsFinite , Ptr <decQuad> -> IO <uint32_t>-#ccall_unsafe decQuadIsInteger , Ptr <decQuad> -> IO <uint32_t>-#ccall_unsafe decQuadIsLogical , Ptr <decQuad> -> IO <uint32_t>-#ccall_unsafe decQuadIsInfinite , Ptr <decQuad> -> IO <uint32_t>-#ccall_unsafe decQuadIsNaN , Ptr <decQuad> -> IO <uint32_t>-#ccall_unsafe decQuadIsNegative , Ptr <decQuad> -> IO <uint32_t>-#ccall_unsafe decQuadIsNormal , Ptr <decQuad> -> IO <uint32_t>-#ccall_unsafe decQuadIsPositive , Ptr <decQuad> -> IO <uint32_t>-#ccall_unsafe decQuadIsSignaling , Ptr <decQuad> -> IO <uint32_t>-#ccall_unsafe decQuadIsSigned , Ptr <decQuad> -> IO <uint32_t>-#ccall_unsafe decQuadIsSubnormal , Ptr <decQuad> -> IO <uint32_t>-#ccall_unsafe decQuadIsZero , Ptr <decQuad> -> IO <uint32_t>-#ccall_unsafe decQuadRadix , Ptr <decQuad> -> IO <uint32_t>-#ccall_unsafe decQuadSameQuantum , Ptr <decQuad> -> Ptr <decQuad> -> IO <uint32_t>-#ccall_unsafe decQuadVersion , IO CString+foreign import ccall unsafe "decQuadClass" unsafe'c'decQuadClass+ :: Ptr C'decQuad+ -> IO C'decClass++foreign import ccall unsafe "decQuadClassString" unsafe'c'decQuadClassString+ :: Ptr C'decQuad+ -> IO CString++foreign import ccall unsafe "decQuadDigits" unsafe'c'decQuadDigits+ :: Ptr C'decQuad+ -> IO C'uint32_t++foreign import ccall unsafe "decQuadIsCanonical" unsafe'c'decQuadIsCanonical+ :: Ptr C'decQuad+ -> IO C'uint32_t++foreign import ccall unsafe "decQuadIsFinite" unsafe'c'decQuadIsFinite+ :: Ptr C'decQuad+ -> IO C'uint32_t++foreign import ccall unsafe "decQuadIsInteger" unsafe'c'decQuadIsInteger+ :: Ptr C'decQuad+ -> IO C'uint32_t++foreign import ccall unsafe "decQuadIsLogical" unsafe'c'decQuadIsLogical+ :: Ptr C'decQuad+ -> IO C'uint32_t++foreign import ccall unsafe "decQuadIsInfinite" unsafe'c'decQuadIsInfinite+ :: Ptr C'decQuad+ -> IO C'uint32_t++foreign import ccall unsafe "decQuadIsNaN" unsafe'c'decQuadIsNaN+ :: Ptr C'decQuad+ -> IO C'uint32_t++foreign import ccall unsafe "decQuadIsNegative" unsafe'c'decQuadIsNegative+ :: Ptr C'decQuad+ -> IO C'uint32_t++foreign import ccall unsafe "decQuadIsNormal" unsafe'c'decQuadIsNormal+ :: Ptr C'decQuad+ -> IO C'uint32_t++foreign import ccall unsafe "decQuadIsPositive" unsafe'c'decQuadIsPositive+ :: Ptr C'decQuad+ -> IO C'uint32_t++foreign import ccall unsafe "decQuadIsSignaling" unsafe'c'decQuadIsSignaling+ :: Ptr C'decQuad+ -> IO C'uint32_t++foreign import ccall unsafe "decQuadIsSigned" unsafe'c'decQuadIsSigned+ :: Ptr C'decQuad+ -> IO C'uint32_t++foreign import ccall unsafe "decQuadIsSubnormal" unsafe'c'decQuadIsSubnormal+ :: Ptr C'decQuad+ -> IO C'uint32_t++foreign import ccall unsafe "decQuadIsZero" unsafe'c'decQuadIsZero+ :: Ptr C'decQuad+ -> IO C'uint32_t++foreign import ccall unsafe "decQuadRadix" unsafe'c'decQuadRadix+ :: Ptr C'decQuad+ -> IO C'uint32_t++foreign import ccall unsafe "decQuadSameQuantum" unsafe'c'decQuadSameQuantum+ :: Ptr C'decQuad+ -> Ptr C'decQuad+ -> IO C'uint32_t++foreign import ccall unsafe "decQuadVersion" unsafe'c'decQuadVersion+ :: IO CString
lib/Data/Deka/Internal.hs view
@@ -14,6 +14,48 @@ import Control.Monad import System.IO.Unsafe (unsafePerformIO) +-- # Helpers++type Boolean+ = Ptr C'decQuad+ -> IO C'uint32_t++boolean+ :: Boolean+ -> Quad+ -> Bool+boolean f d = unsafePerformIO $+ withForeignPtr (unQuad d) $ \pD ->+ f pD >>= \r ->+ return $ case r of+ 1 -> True+ 0 -> False+ _ -> error "boolean: bad return value"++-- | Creates a new Quad. Uninitialized, so don't export this+-- function.+newQuad :: IO Quad+newQuad = fmap Quad mallocForeignPtr++type BinaryCtxFree+ = Ptr C'decQuad+ -> Ptr C'decQuad+ -> Ptr C'decQuad+ -> IO (Ptr C'decQuad)++binaryCtxFree+ :: BinaryCtxFree+ -> Quad+ -> Quad+ -> Quad+binaryCtxFree f x y = unsafePerformIO $+ newQuad >>= \r ->+ withForeignPtr (unQuad r) $ \pR ->+ withForeignPtr (unQuad x) $ \pX ->+ withForeignPtr (unQuad y) $ \pY ->+ f pR pX pY >>+ return r+ -- | The Ctx monad -- -- The General Decimal Arithmetic specification states that most@@ -47,6 +89,21 @@ -- particular 'Quad'. newtype Quad = Quad { unQuad :: ForeignPtr C'decQuad } +-- | The Eq instance depends on an IEEE 754 total ordering. In+-- particular, note that, for example, @7.5@ is not equal to @7.50@.+-- See+--+-- <http://speleotrove.com/decimal/decifaq4.html#order>++instance Eq Quad where+ x == y = case compareTotal x y of+ EQ -> True+ _ -> False++-- | Like the 'Eq' instance, this uses an IEEE 754 total ordering.+instance Ord Quad where+ compare = compareTotal+ -- | The Show instance uses 'toByteString'. instance Show Quad where show = BS8.unpack . toByteString@@ -75,4 +132,32 @@ allocaBytes c'DECQUAD_String $ \pS -> f pD pS >> BS8.packCString pS++-- | Compares using an IEEE 754 total ordering, which takes into+-- account the exponent. IEEE 754 says that this function might+-- return different results depending upon whether the operands are+-- canonical; 'Quad' are always canonical so you don't need to worry+-- about that here.+compareTotal :: Quad -> Quad -> Ordering+compareTotal x y+ | isNegative c = LT+ | isZero c = EQ+ | isPositive c = GT+ | otherwise = error "compareTotal: unknown result"+ where+ c = binaryCtxFree unsafe'c'decQuadCompareTotal x y++-- # Tests++-- | True only if @x@ is less than zero and is not an NaN.+isNegative :: Quad -> Bool+isNegative = boolean unsafe'c'decQuadIsNegative++-- | True only if @x@ is a zero.+isZero :: Quad -> Bool+isZero = boolean unsafe'c'decQuadIsZero++-- | True only if @x@ is greater than zero and is not an NaN.+isPositive :: Quad -> Bool+isPositive = boolean unsafe'c'decQuadIsPositive
lib/Data/Deka/Quad.hs view
@@ -27,7 +27,6 @@ ( -- * Quad Quad- , QuadT(..) -- * Rounding -- | For more on the rounding algorithms, see@@ -95,6 +94,8 @@ , toEngByteString -- * Converting to and from integers+ , C'int32_t+ , C'uint32_t , fromInt32 , fromUInt32 , toInt32@@ -556,34 +557,8 @@ | otherwise = error "decClass show: invalid value" --- | A Quad is not a member of 'Eq' or 'Ord' because the semantics--- of the 'compare' function do not easily allow for this. However,--- if you want to compare using a total ordering, you can wrap your--- 'Quad' in 'QuadT'. For more on what a total ordering is, see------ <http://speleotrove.com/decimal/decifaq4.html>------ and look under @Which is larger? 7.5 or 7.500?@. As this--- title suggests, when using a total ordering, @7.5@ and @7.500@--- are not equal.--newtype QuadT = QuadT { unQuadT :: Quad }- deriving Show--instance Eq QuadT where- QuadT x == QuadT y = compareTotal x y == EQ--instance Ord QuadT where- compare (QuadT x) (QuadT y) = compareTotal x y-- -- # Helpers. Do not export these. --- | Creates a new Quad. Uninitialized, so don't export this--- function.-newQuad :: IO Quad-newQuad = fmap Quad mallocForeignPtr- type Unary = Ptr C'decQuad -> Ptr C'decQuad@@ -621,25 +596,6 @@ f pR pX pY pC >> return r -type BinaryCtxFree- = Ptr C'decQuad- -> Ptr C'decQuad- -> Ptr C'decQuad- -> IO (Ptr C'decQuad)--binaryCtxFree- :: BinaryCtxFree- -> Quad- -> Quad- -> Quad-binaryCtxFree f x y = unsafePerformIO $- newQuad >>= \r ->- withForeignPtr (unQuad r) $ \pR ->- withForeignPtr (unQuad x) $ \pX ->- withForeignPtr (unQuad y) $ \pY ->- f pR pX pY >>- return r- type UnaryGet a = Ptr C'decQuad -> IO a@@ -674,22 +630,6 @@ f pR pX pY pZ pC >> return r -type Boolean- = Ptr C'decQuad- -> IO C'uint32_t--boolean- :: Boolean- -> Quad- -> Bool-boolean f d = unsafePerformIO $- withForeignPtr (unQuad d) $ \pD ->- f pD >>= \r ->- return $ case r of- 1 -> True- 0 -> False- _ -> error "boolean: bad return value"- -- MkString and mkString - moved to Internal so that toByteString -- can use them @@ -767,20 +707,6 @@ compareSignal :: Quad -> Quad -> Ctx Quad compareSignal = binary unsafe'c'decQuadCompareSignal --- | Compares using an IEEE 754 total ordering, which takes into--- account the exponent. IEEE 754 says that this function might--- return different results depending upon whether the operands are--- canonical; 'Quad' are always canonical so you don't need to worry--- about that here.-compareTotal :: Quad -> Quad -> Ordering-compareTotal x y =- let c = binaryCtxFree unsafe'c'decQuadCompareTotal x y- r | isNegative c = LT- | isZero c = EQ- | isPositive c = GT- | otherwise = error "compareTotal: unknown result"- in r- -- | Same as 'compareTotal' but compares the absolute value of the -- two arguments. compareTotalMag :: Quad -> Quad -> Ordering@@ -902,18 +828,10 @@ isNaN :: Quad -> Bool isNaN = boolean unsafe'c'decQuadIsNaN --- | True only if @x@ is less than zero and is not an NaN.-isNegative :: Quad -> Bool-isNegative = boolean unsafe'c'decQuadIsNegative- -- | True only if @x@ is finite, non-zero, and not subnormal. isNormal :: Quad -> Bool isNormal = boolean unsafe'c'decQuadIsNormal --- | True only if @x@ is greater than zero and is not an NaN.-isPositive :: Quad -> Bool-isPositive = boolean unsafe'c'decQuadIsPositive- -- | True only if @x@ is a signaling NaN. isSignaling :: Quad -> Bool isSignaling = boolean unsafe'c'decQuadIsSignaling@@ -927,10 +845,6 @@ -- with a magnitude less than 10 ^ emin. isSubnormal :: Quad -> Bool isSubnormal = boolean unsafe'c'decQuadIsSubnormal---- | True only if @x@ is a zero.-isZero :: Quad -> Bool-isZero = boolean unsafe'c'decQuadIsZero -- | @logB x@ Returns the adjusted exponent of x, according to IEEE -- 754 rules. If @x@ is infinite, returns +Infinity. If @x@ is