decimal-arithmetic 0.2.0.0 → 0.3.0.0
raw patch · 12 files changed
+1116/−338 lines, 12 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
- Numeric.Decimal: toBool :: Decimal p r -> Bool
- Numeric.Decimal: type PPlus1 p = PPlus p P1 A precision of (@p@ + 1) significant digits
- Numeric.Decimal: type PPlus2 p = PPlus p P2 A precision of (@p@ + 2) significant digits
- Numeric.Decimal: type PPlus3 p = PPlus p P3 A precision of (@p@ + 3) significant digits
- Numeric.Decimal: type PPlus4 p = PPlus p P4 A precision of (@p@ + 4) significant digits
- Numeric.Decimal: type PPlus5 p = PPlus p P5 A precision of (@p@ + 5) significant digits
- Numeric.Decimal: type PPlus6 p = PPlus p P6 A precision of (@p@ + 6) significant digits
- Numeric.Decimal: type PPlus7 p = PPlus p P7 A precision of (@p@ + 7) significant digits
- Numeric.Decimal: type PPlus8 p = PPlus p P8 A precision of (@p@ + 8) significant digits
- Numeric.Decimal: type PPlus9 p = PPlus p P9 A precision of (@p@ + 9) significant digits
- Numeric.Decimal: type PTimes10 = PTimes P10
- Numeric.Decimal: type PTimes2 = PTimes P2
- Numeric.Decimal.Operation: Class :: Sign -> Subclass -> Class
- Numeric.Decimal.Operation: data Subclass
- Numeric.Decimal.Operation: instance GHC.Classes.Eq Numeric.Decimal.Operation.Subclass
+ Numeric.Decimal: data PPlus1 p
+ Numeric.Decimal: data PTimes2 p
+ Numeric.Decimal: fromBool :: Bool -> Decimal p r
+ Numeric.Decimal.Arithmetic: Round05Up :: RoundingAlgorithm
+ Numeric.Decimal.Arithmetic: RoundCeiling :: RoundingAlgorithm
+ Numeric.Decimal.Arithmetic: RoundDown :: RoundingAlgorithm
+ Numeric.Decimal.Arithmetic: RoundFloor :: RoundingAlgorithm
+ Numeric.Decimal.Arithmetic: RoundHalfDown :: RoundingAlgorithm
+ Numeric.Decimal.Arithmetic: RoundHalfEven :: RoundingAlgorithm
+ Numeric.Decimal.Arithmetic: RoundHalfUp :: RoundingAlgorithm
+ Numeric.Decimal.Arithmetic: RoundUp :: RoundingAlgorithm
+ Numeric.Decimal.Arithmetic: allSignals :: Signals
+ Numeric.Decimal.Arithmetic: data RoundingAlgorithm
+ Numeric.Decimal.Arithmetic: getPrecision :: Precision p => Arith p r (Maybe Int)
+ Numeric.Decimal.Arithmetic: getRounding :: Rounding r => Arith p r RoundingAlgorithm
+ Numeric.Decimal.Arithmetic: subArith :: Arith a b (Decimal a b) -> Arith p r (Decimal a b)
+ Numeric.Decimal.Operation: NumberClass :: Sign -> NumberClass -> Class
+ Numeric.Decimal.Operation: QNaNClass :: NaNClass
+ Numeric.Decimal.Operation: SNaNClass :: NaNClass
+ Numeric.Decimal.Operation: compareSignal :: (Precision p, Rounding r) => Decimal a b -> Decimal c d -> Arith p r (Decimal p r)
+ Numeric.Decimal.Operation: data NaNClass
+ Numeric.Decimal.Operation: data NumberClass
+ Numeric.Decimal.Operation: exp :: FinitePrecision p => Decimal a b -> Arith p r (Decimal p RoundHalfEven)
+ Numeric.Decimal.Operation: fusedMultiplyAdd :: (Precision p, Rounding r) => Decimal a b -> Decimal c d -> Decimal e f -> Arith p r (Decimal p r)
+ Numeric.Decimal.Operation: instance GHC.Classes.Eq Numeric.Decimal.Operation.NaNClass
+ Numeric.Decimal.Operation: instance GHC.Classes.Eq Numeric.Decimal.Operation.NumberClass
+ Numeric.Decimal.Operation: ln :: FinitePrecision p => Decimal a b -> Arith p r (Decimal p RoundHalfEven)
+ Numeric.Decimal.Operation: log10 :: FinitePrecision p => Decimal a b -> Arith p r (Decimal p RoundHalfEven)
+ Numeric.Decimal.Operation: logb :: (Precision p, Rounding r) => Decimal a b -> Arith p r (Decimal p r)
+ Numeric.Decimal.Operation: power :: (FinitePrecision p, Rounding r) => Decimal a b -> Decimal c d -> Arith p r (Decimal p r)
+ Numeric.Decimal.Operation: quantize :: (Precision p, Rounding r) => Decimal p r -> Decimal a b -> Arith p r (Decimal p r)
+ Numeric.Decimal.Operation: shift :: Precision p => Decimal p a -> Decimal b c -> Arith p r (Decimal p a)
+ Numeric.Decimal.Operation: squareRoot :: FinitePrecision p => Decimal a b -> Arith p r (Decimal p RoundHalfEven)
- Numeric.Decimal: type P2 = PPlus1 P1
+ Numeric.Decimal: type P2 = PTimes2 P1
- Numeric.Decimal: type P250 = PTimes10 P25
+ Numeric.Decimal: type P250 = PTimes2 P125
- Numeric.Decimal: type P75 = PPlus5 (PTimes10 P7)
+ Numeric.Decimal: type P75 = PPlus1 P74
- Numeric.Decimal.Operation: InfinityClass :: Subclass
+ Numeric.Decimal.Operation: InfinityClass :: NumberClass
- Numeric.Decimal.Operation: NaNClass :: Subclass
+ Numeric.Decimal.Operation: NaNClass :: NaNClass -> Class
- Numeric.Decimal.Operation: NormalClass :: Subclass
+ Numeric.Decimal.Operation: NormalClass :: NumberClass
- Numeric.Decimal.Operation: SubnormalClass :: Subclass
+ Numeric.Decimal.Operation: SubnormalClass :: NumberClass
- Numeric.Decimal.Operation: ZeroClass :: Subclass
+ Numeric.Decimal.Operation: ZeroClass :: NumberClass
- Numeric.Decimal.Operation: isCanonical :: Decimal a b -> Arith p r (Decimal p r)
+ Numeric.Decimal.Operation: isCanonical :: Decimal a b -> Arith p r Bool
- Numeric.Decimal.Operation: isFinite :: Decimal a b -> Arith p r (Decimal p r)
+ Numeric.Decimal.Operation: isFinite :: Decimal a b -> Arith p r Bool
- Numeric.Decimal.Operation: isInfinite :: Decimal a b -> Arith p r (Decimal p r)
+ Numeric.Decimal.Operation: isInfinite :: Decimal a b -> Arith p r Bool
- Numeric.Decimal.Operation: isNaN :: Decimal a b -> Arith p r (Decimal p r)
+ Numeric.Decimal.Operation: isNaN :: Decimal a b -> Arith p r Bool
- Numeric.Decimal.Operation: isNormal :: Precision a => Decimal a b -> Arith p r (Decimal p r)
+ Numeric.Decimal.Operation: isNormal :: Precision a => Decimal a b -> Arith p r Bool
- Numeric.Decimal.Operation: isQNaN :: Decimal a b -> Arith p r (Decimal p r)
+ Numeric.Decimal.Operation: isQNaN :: Decimal a b -> Arith p r Bool
- Numeric.Decimal.Operation: isSNaN :: Decimal a b -> Arith p r (Decimal p r)
+ Numeric.Decimal.Operation: isSNaN :: Decimal a b -> Arith p r Bool
- Numeric.Decimal.Operation: isSigned :: Decimal a b -> Arith p r (Decimal p r)
+ Numeric.Decimal.Operation: isSigned :: Decimal a b -> Arith p r Bool
- Numeric.Decimal.Operation: isSubnormal :: Precision a => Decimal a b -> Arith p r (Decimal p r)
+ Numeric.Decimal.Operation: isSubnormal :: Precision a => Decimal a b -> Arith p r Bool
- Numeric.Decimal.Operation: isZero :: Decimal a b -> Arith p r (Decimal p r)
+ Numeric.Decimal.Operation: isZero :: Decimal a b -> Arith p r Bool
- Numeric.Decimal.Operation: sameQuantum :: Decimal a b -> Decimal c d -> Arith p r (Decimal p r)
+ Numeric.Decimal.Operation: sameQuantum :: Decimal a b -> Decimal c d -> Arith p r Bool
Files
- README.md +2/−2
- decimal-arithmetic.cabal +1/−1
- src/Numeric/Decimal.hs +1/−1
- src/Numeric/Decimal/Arithmetic.hs +39/−5
- src/Numeric/Decimal/Arithmetic.hs-boot +3/−2
- src/Numeric/Decimal/Conversion.hs +5/−5
- src/Numeric/Decimal/Number.hs +52/−6
- src/Numeric/Decimal/Operation.hs +829/−143
- src/Numeric/Decimal/Operation.hs-boot +16/−1
- src/Numeric/Decimal/Precision.hs +21/−38
- src/Numeric/Decimal/Rounding.hs +105/−123
- stack.yaml +42/−11
README.md view
@@ -10,5 +10,5 @@ [General Decimal Arithmetic]: http://speleotrove.com/decimal/ -While usable, the implementation is currently in its infancy. Additional-operations and possible API changes are planned.+While currently usable, the implementation is still under development.+Additional operations and possible API changes are planned.
decimal-arithmetic.cabal view
@@ -1,6 +1,6 @@ name: decimal-arithmetic-version: 0.2.0.0+version: 0.3.0.0 synopsis: An implementation of Mike Cowlishaw's General Decimal Arithmetic Specification
src/Numeric/Decimal.hs view
@@ -66,7 +66,7 @@ -- * Functions , cast- , toBool+ , fromBool ) where import Numeric.Decimal.Number
src/Numeric/Decimal/Arithmetic.hs view
@@ -14,6 +14,9 @@ Context , newContext , flags+ , getPrecision+ , getRounding+ , RoundingAlgorithm(..) -- *** Default contexts -- $default-contexts@@ -24,6 +27,7 @@ , Arith , runArith , evalArith+ , subArith -- * Exceptional conditions -- $exceptional-conditions@@ -36,6 +40,7 @@ , Signals , signal , signals+ , allSignals , signalMember , raiseSignal@@ -50,7 +55,8 @@ ExceptT, runExceptT) import Control.Monad.State (MonadState(get, put), modify, gets, State, runState, evalState)-import Data.Bits (bit, complement, testBit, (.&.), (.|.))+import Data.Bits (zeroBits, bit, complement, testBit, (.&.), (.|.))+import Data.Coerce (coerce) import Data.Monoid ((<>)) import Numeric.Decimal.Number@@ -152,6 +158,30 @@ evalArith :: Arith p r a -> Context p r -> Either (Exception p r) a evalArith (Arith e) = evalState (runExceptT e) +-- | Perform a subcomputation using a different precision and/or rounding+-- algorithm. The subcomputation is evaluated within a new context with all+-- flags cleared and all traps disabled. Any flags set in the context of the+-- subcomputation are ignored, but if an exception is returned it will be+-- re-raised within the current context.+subArith :: Arith a b (Decimal a b) -> Arith p r (Decimal a b)+subArith arith = case evalArith arith newContext of+ Left e -> let result = coerce (exceptionResult e)+ in coerce <$> raiseSignal (exceptionSignal e) result+ Right r -> return r++-- | Return the precision of the arithmetic context (or 'Nothing' if the+-- precision is infinite).+getPrecision :: Precision p => Arith p r (Maybe Int)+getPrecision = getPrecision' undefined+ where getPrecision' :: Precision p => p -> Arith p r (Maybe Int)+ getPrecision' = return . precision++-- | Return the rounding algorithm of the arithmetic context.+getRounding :: Rounding r => Arith p r RoundingAlgorithm+getRounding = getRounding' undefined+ where getRounding' :: Rounding r => r -> Arith p r RoundingAlgorithm+ getRounding' = return . rounding+ -- $exceptional-conditions -- -- Exceptional conditions are grouped into signals, which can be controlled@@ -190,7 +220,7 @@ showString "signals " . showsPrec 11 (signalList sigs) instance Monoid Signals where- mempty = Signals 0+ mempty = Signals zeroBits Signals x `mappend` Signals y = Signals (x .|. y) -- | Create a set of signals from a singleton.@@ -201,6 +231,10 @@ signals :: [Signal] -> Signals signals = mconcat . map signal +-- | A set containing every signal+allSignals :: Signals+allSignals = Signals (complement zeroBits)+ -- | Enumerate the given set of signals. signalList :: Signals -> [Signal] signalList sigs = filter (`signalMember` sigs) [minBound..maxBound]@@ -229,9 +263,9 @@ clearFlags sigs = modify $ \ctx -> ctx { flags = unsignal sigs (flags ctx) } -- | A trap handler function may return a substitute result for the operation--- that caused the exceptional condition, or it may call 'throwError' to abort--- the arithmetic computation (or pass control to an enclosing 'catchError'--- handler).+-- that caused the exceptional condition, or it may call 'throwError' to pass+-- control to an enclosing 'catchError' handler (or abort the arithmetic+-- computation). type TrapHandler p r = Exception p r -> Arith p r (Decimal p r) -- | Evaluate an arithmetic computation within a modified context that enables
src/Numeric/Decimal/Arithmetic.hs-boot view
@@ -6,6 +6,7 @@ ( Arith , newContext , evalArith+ , getPrecision , Signal(..) , raiseSignal , exceptionResult@@ -15,8 +16,7 @@ import Control.Monad.State (State) import {-# SOURCE #-} Numeric.Decimal.Number----instance Precision p => Precision (Arith p r a)+import Numeric.Decimal.Precision (Precision) data Context p r newContext :: Context p r@@ -26,6 +26,7 @@ instance Applicative (Arith p r) instance Monad (Arith p r) evalArith :: Arith p r a -> Context p r -> Either (Exception p r) a+getPrecision :: Precision p => Arith p r (Maybe Int) data Signal = Clamped
src/Numeric/Decimal/Conversion.hs view
@@ -18,7 +18,7 @@ , toNumber ) where -import Prelude hiding (exponent, round)+import Prelude hiding (exponent) import Control.Applicative ((<|>)) import Data.Char (isDigit, digitToInt, toLower, toUpper)@@ -249,12 +249,12 @@ SNaN { payload = p } -> showString "sNaN" . diag p where signStr :: ShowS- signStr = showString $ case sign num of- Pos -> ""- Neg -> "-"+ signStr = case sign num of+ Pos -> id+ Neg -> showChar '-' diag :: Payload -> ShowS- diag 0 = showString ""+ diag 0 = id diag d = shows d showExponent :: Exponent -> ShowS
src/Numeric/Decimal/Number.hs view
@@ -12,15 +12,18 @@ , Decimal(..) , zero+ , oneHalf , one , negativeOne+ , two+ , ten , infinity , qNaN , sNaN , flipSign , cast- , toBool+ , fromBool , isPositive , isNegative@@ -28,10 +31,14 @@ , isZero , isNormal , isSubnormal++ , adjustedExponent+ , integralValue ) where -import Prelude hiding (exponent, round)+import Prelude hiding (exponent) +import Control.Monad (join) import Data.Char (isSpace) import Data.Coerce (coerce) import Data.Ratio (numerator, denominator, (%))@@ -239,7 +246,7 @@ x / y = evalOp (x `Op.divide` y) fromRational r = let n = fromInteger (numerator r) :: GeneralDecimal d = fromInteger (denominator r) :: GeneralDecimal- in coerce n / coerce d+ in evalOp (n `Op.divide` d) {- $doctest-Fractional prop> (4.14 :: Decimal P2 RoundHalfUp) == 4.1@@ -302,22 +309,37 @@ instance (FinitePrecision p, Rounding r) => Floating (Decimal p r) where pi = castDown seriesPi - exp = notyet "exp"- log = notyet "log"+ exp = castRounding . evalOp . Op.exp+ log = castRounding . evalOp . Op.ln + logBase 10 x = castRounding $ evalOp (Op.log10 x)+ logBase _ 1 = zero+ logBase b x = evalOp (join $ Op.divide <$> Op.ln x <*> Op.ln b)++ x ** y = evalOp (x `Op.power` y)++ sqrt = castRounding . evalOp . Op.squareRoot+ sin = notyet "sin" cos = notyet "cos"+ asin = notyet "asin" acos = notyet "acos" atan = notyet "atan"+ sinh = notyet "sinh" cosh = notyet "cosh"+ asinh = notyet "asinh" acosh = notyet "acosh" atanh = notyet "atanh" {- $doctest-Floating prop> realToFrac (pi :: ExtendedDecimal P16) == (pi :: Double)++prop> y >= 0 ==> (x :: BasicDecimal) ** fromInteger y == x ^ y++prop> isFinite x && x >= 0 ==> coefficient (sqrt (x * x) - (x :: ExtendedDecimal P16)) <= 1 -} instance (FinitePrecision p, Rounding r) => RealFloat (Decimal p r) where@@ -397,6 +419,10 @@ two :: Decimal p r two = zero { coefficient = 2 } +-- | A 'Decimal' representing the value ten+ten :: Decimal p r+ten = zero { coefficient = 10 }+ -- | A 'Decimal' representing the value negative one negativeOne :: Decimal p r negativeOne = one { sign = Neg }@@ -421,8 +447,13 @@ -- immediately rounding if necessary to the new precision using the new -- algorithm. cast :: (Precision p, Rounding r) => Decimal a b -> Decimal p r-cast = evalOp . round . coerce+cast = evalOp . roundDecimal +-- | Cast a 'Decimal' to another rounding algorithm, maintaining the same+-- precision. No new rounding occurs.+castRounding :: Decimal p a -> Decimal p r+castRounding = coerce+ -- | Return the number of decimal digits of the argument. numDigits :: Coefficient -> Int numDigits x@@ -474,6 +505,14 @@ | isFinite n && not (isZero n) = maybe False (adjustedExponent n <) (eMin n) | otherwise = False +-- | If the argument is 'False', return a 'Decimal' value zero; if 'True',+-- return the value one. This is basically an optimized @toEnum . fromEnum@ to+-- support an all-decimal usage of the operations from+-- "Numeric.Decimal.Operation" that return a 'Bool'.+fromBool :: Bool -> Decimal p r+fromBool False = zero+fromBool True = one+ -- | Return 'False' if the argument is zero or NaN, and 'True' otherwise. toBool :: Decimal p r -> Bool toBool Num { coefficient = c }@@ -514,3 +553,10 @@ e + fromIntegral (clength - 1) where clength = numDigits c :: Int adjustedExponent _ = error "adjustedExponent: not a finite number"++integralValue :: Decimal a b -> Maybe Integer+integralValue Num { sign = s, coefficient = c, exponent = e }+ | e >= 0 = Just (signFunc s $ fromIntegral c * 10^e)+ | r == 0 = Just (signFunc s $ fromIntegral q)+ where (q, r) = c `quotRem` (10^(-e))+integralValue _ = Nothing
src/Numeric/Decimal/Operation.hs view
@@ -20,13 +20,13 @@ , add , subtract , compare- -- compareSignal+ , compareSignal , divide -- divideInteger- -- exp- -- fusedMultiplyAdd- -- ln- -- log10+ , exp+ , fusedMultiplyAdd+ , ln+ , log10 , max , maxMagnitude , min@@ -37,53 +37,56 @@ -- nextMinus -- nextPlus -- nextToward- -- power- -- quantize- , reduce+ , power+ , quantize+ , reduce -- remainder -- remainderNear -- roundToIntegralExact -- roundToIntegralValue- -- squareRoot+ , squareRoot -- * Miscellaneous operations -- $miscellaneous-operations -- and- , canonical- , class_, Class(..), Sign(..), Subclass(..)+ , canonical+ , class_, Class(..), Sign(..), NumberClass(..), NaNClass(..) -- compareTotal -- compareTotalMagnitude- , copy- , copyAbs- , copyNegate- , copySign+ , copy+ , copyAbs+ , copyNegate+ , copySign -- invert- , isCanonical- , isFinite- , isInfinite- , isNaN- , isNormal- , isQNaN- , isSigned- , isSNaN- , isSubnormal- , isZero- -- logb+ , isCanonical+ , isFinite+ , isInfinite+ , isNaN+ , isNormal+ , isQNaN+ , isSigned+ , isSNaN+ , isSubnormal+ , isZero+ , logb -- or- , radix+ , radix -- rotate- , sameQuantum+ , sameQuantum -- scaleb- -- shift+ , shift -- xor ) where -import Prelude hiding (abs, compare, exponent, isInfinite, isNaN, max, min,- round, subtract)+import Prelude hiding (abs, compare, exp, exponent, isInfinite, isNaN, max, min,+ subtract) import qualified Prelude +import Control.Monad (join) import Data.Coerce (coerce)+import Data.List (find)+import Data.Maybe (fromMaybe) import Numeric.Decimal.Arithmetic import Numeric.Decimal.Number hiding (isFinite, isNormal, isSubnormal, isZero)@@ -105,7 +108,7 @@ arithRounding = undefined result :: (Precision p, Rounding r) => Decimal p r -> Arith p r (Decimal p r)-result = round -- ...+result = roundDecimal -- ... -- | maybe False (numDigits c >) (precision r) = undefined invalidOperation :: Decimal a b -> Arith p r (Decimal p r)@@ -123,6 +126,10 @@ toQNaN2 _ nan@QNaN{} = coerce nan toQNaN2 n _ = toQNaN n +quietToSignal :: Decimal p r -> Decimal p r+quietToSignal QNaN { sign = s, payload = p } = SNaN { sign = s, payload = p }+quietToSignal x = x+ -- $arithmetic-operations -- -- This section describes the arithmetic operations on, and some other@@ -278,10 +285,14 @@ multiply Inf { sign = xs } Inf { sign = ys } = return Inf { sign = xorSigns xs ys }-multiply Inf { sign = xs } Num { sign = ys } =- return Inf { sign = xorSigns xs ys }-multiply Num { sign = xs } Inf { sign = ys } =- return Inf { sign = xorSigns xs ys }+multiply Inf { sign = xs } Num { sign = ys, coefficient = yc }+ | yc == 0 = invalidOperation qNaN+ | otherwise = return Inf { sign = xorSigns xs ys }+multiply Num { sign = xs, coefficient = xc } Inf { sign = ys }+ | xc == 0 = invalidOperation qNaN+ | otherwise = return Inf { sign = xorSigns xs ys }+multiply nan@SNaN{} _ = invalidOperation nan+multiply _ nan@SNaN{} = invalidOperation nan multiply x y = return (toQNaN2 x y) {- $doctest-multiply@@ -301,8 +312,290 @@ 4.28135971E+11 -} --- | 'divide' takes two operands. If either operand is a /special value/ then the general rules apply.+-- | 'exp' takes one operand. If the operand is a NaN then the general rules+-- for special values apply. --+-- Otherwise, the result is /e/ raised to the power of the operand, with the+-- following cases:+--+-- * If the operand is -Infinity, the result is 0 and exact.+--+-- * If the operand is a zero, the result is 1 and exact.+--+-- * If the operand is +Infinity, the result is +Infinity and exact.+--+-- * Otherwise the result is inexact and will be rounded using the+-- /round-half-even/ algorithm. The coefficient will have exactly /precision/+-- digits (unless the result is subnormal). These inexact results should be+-- correctly rounded, but may be up to 1 ulp (unit in last place) in error.+exp :: FinitePrecision p => Decimal a b -> Arith p r (Decimal p RoundHalfEven)+exp x@Num { sign = s, coefficient = c }+ | c == 0 = return one+ | s == Neg = subArith (maclaurin x { sign = Pos } >>= reciprocal) >>=+ subRounded >>= result+ | otherwise = subArith (maclaurin x) >>= subRounded >>= result++ where multiplyExact :: Decimal a b -> Decimal c d+ -> Arith PInfinite RoundHalfEven+ (Decimal PInfinite RoundHalfEven)+ multiplyExact = multiply++ maclaurin :: FinitePrecision p => Decimal a b+ -> Arith p RoundHalfEven (Decimal p RoundHalfEven)+ maclaurin x+ | adjustedExponent x >= 0 = subArith (subMaclaurin x) >>= subRounded+ | otherwise = sum one one one one+ where sum :: FinitePrecision p+ => Decimal p RoundHalfEven+ -> Decimal PInfinite RoundHalfEven+ -> Decimal PInfinite RoundHalfEven+ -> Decimal PInfinite RoundHalfEven+ -> Arith p RoundHalfEven (Decimal p RoundHalfEven)+ sum s num den n = do+ num' <- subArith (multiplyExact num x)+ den' <- subArith (multiplyExact den n)+ s' <- add s =<< divide num' den'+ if s' == s then return s'+ else sum s' num' den' =<< subArith (add n one)++ subMaclaurin :: FinitePrecision p => Decimal a b+ -> Arith p RoundHalfEven (Decimal p RoundHalfEven)+ subMaclaurin x = subArith (multiplyExact x oneHalf) >>= maclaurin >>=+ \r -> multiply r r++ subRounded :: Precision p+ => Decimal (PPlus1 (PPlus1 p)) a+ -> Arith p r (Decimal p RoundHalfEven)+ subRounded = subArith . roundDecimal++ result :: Decimal p a -> Arith p r (Decimal p a)+ result r = coerce <$> (raiseSignal Rounded =<< raiseSignal Inexact r')+ where r' = coerce r++exp n@Inf { sign = s }+ | s == Pos = return (coerce n)+ | otherwise = return zero+exp n@QNaN{} = return (coerce n)+exp n@SNaN{} = coerce <$> invalidOperation n++{- $doctest-exp+>>> op1 Op.exp "-Infinity"+0++>>> op1 Op.exp "-1"+0.367879441++>>> op1 Op.exp "0"+1++>>> op1 Op.exp "1"+2.71828183++>>> op1 Op.exp "0.693147181"+2.00000000++>>> op1 Op.exp "+Infinity"+Infinity+-}++-- | 'fusedMultiplyAdd' takes three operands; the first two are multiplied+-- together, using 'multiply', with sufficient precision and exponent range+-- that the result is exact and unrounded. No /flags/ are set by the+-- multiplication unless one of the first two operands is a signaling NaN or+-- one is a zero and the other is an infinity.+--+-- Unless the multiplication failed, the third operand is then added to the+-- result of that multiplication, using 'add', under the current context.+--+-- In other words, @fusedMultiplyAdd x y z@ delivers a result which is @(x ×+-- y) + z@ with only the one, final, rounding.+fusedMultiplyAdd :: (Precision p, Rounding r)+ => Decimal a b -> Decimal c d -> Decimal e f+ -> Arith p r (Decimal p r)+fusedMultiplyAdd x y z =+ either raise (return . coerce) (exactMult x y) >>= add z++ where exactMult :: Rounding r => Decimal a b -> Decimal c d+ -> Either (Exception PInfinite r) (Decimal PInfinite r)+ exactMult x y = evalArith (multiply x y) newContext++ raise :: Exception a r -> Arith p r (Decimal p r)+ raise e = raiseSignal (exceptionSignal e) (coerce $ exceptionResult e)++{- $doctest-fusedMultiplyAdd+>>> op3 Op.fusedMultiplyAdd "3" "5" "7"+22++>>> op3 Op.fusedMultiplyAdd "3" "-5" "7"+-8++>>> op3 Op.fusedMultiplyAdd "888565290" "1557.96930" "-86087.7578"+1.38435736E+12+-}++-- | 'ln' takes one operand. If the operand is a NaN then the general rules+-- for special values apply.+--+-- Otherwise, the operand must be a zero or positive, and the result is the+-- natural (base /e/) logarithm of the operand, with the following cases:+--+-- * If the operand is a zero, the result is -Infinity and exact.+--+-- * If the operand is +Infinity, the result is +Infinity and exact.+--+-- * If the operand equals one, the result is 0 and exact.+--+-- * Otherwise the result is inexact and will be rounded using the+-- /round-half-even/ algorithm. The coefficient will have exactly /precision/+-- digits (unless the result is subnormal). These inexact results should be+-- correctly rounded, but may be up to 1 ulp (unit in last place) in error.+ln :: FinitePrecision p => Decimal a b -> Arith p r (Decimal p RoundHalfEven)+ln x@Num { sign = s, coefficient = c, exponent = e }+ | c == 0 = return infinity { sign = Neg }+ | s == Pos = if e <= 0 && c == 10^(-e) then return zero+ else subArith (subLn x) >>= subRounded >>= result++ where subLn :: FinitePrecision p => Decimal a b+ -> Arith p RoundHalfEven (Decimal p RoundHalfEven)+ subLn x = do+ let fe = fromIntegral (-(numDigits c - 1)) :: Exponent+ r = fromIntegral (e - fe) :: Decimal PInfinite RoundHalfEven+ lnf <- taylorLn x { exponent = fe }+ add lnf =<< multiply r =<< ln10++ subRounded :: Precision p => Decimal (PPlus1 (PPlus1 p)) a+ -> Arith p r (Decimal p RoundHalfEven)+ subRounded = subArith . roundDecimal++ result :: Decimal p a -> Arith p r (Decimal p a)+ result r = coerce <$> (raiseSignal Rounded =<< raiseSignal Inexact r')+ where r' = coerce r++ln n@Inf { sign = Pos } = return (coerce n)+ln n@QNaN{} = return (coerce n)+ln n = coerce <$> invalidOperation n++taylorLn :: FinitePrecision p => Decimal a b+ -> Arith p RoundHalfEven (Decimal p RoundHalfEven)+taylorLn x = do+ num <- x `subtract` one+ den <- x `add` one+ multiply two =<< sum =<< num `divide` den++ where sum :: FinitePrecision p => Decimal p RoundHalfEven+ -> Arith p RoundHalfEven (Decimal p RoundHalfEven)+ sum b = multiply b b >>= \b2 -> sum' b b b2 one++ where sum' :: FinitePrecision p+ => Decimal p RoundHalfEven+ -> Decimal p RoundHalfEven+ -> Decimal p RoundHalfEven+ -> Decimal PInfinite RoundHalfEven+ -> Arith p RoundHalfEven (Decimal p RoundHalfEven)+ sum' s m b n = do+ m' <- multiply m b+ n' <- subArith (add n two)+ s' <- add s =<< divide m' n'+ if s' == s then return s' else sum' s' m' b n'++ln10 :: FinitePrecision p => Arith p r (Decimal p RoundHalfEven)+ln10 = getPrecision >>= \(Just p) ->+ if p <= 50 then return fastLn10 else slowLn10++ where fastLn10 :: FinitePrecision p => Decimal p RoundHalfEven+ fastLn10 = 2.3025850929940456840179914546843642076011014886288++ slowLn10 :: FinitePrecision p => Arith p r (Decimal p RoundHalfEven)+ slowLn10 = subArith (taylorLn ten) >>= subRound++ where subRound :: Precision p => Decimal (PPlus1 (PPlus1 p)) a+ -> Arith p r (Decimal p RoundHalfEven)+ subRound = subArith . roundDecimal++{- $doctest-ln+>>> op1 Op.ln "0"+-Infinity++>>> op1 Op.ln "1.000"+0++>>> op1 Op.ln "2.71828183"+1.00000000++>>> op1 Op.ln "10"+2.30258509++>>> op1 Op.ln "+Infinity"+Infinity+-}++-- | 'log10' takes one operand. If the operand is a NaN then the general rules+-- for special values apply.+--+-- Otherwise, the operand must be a zero or positive, and the result is the+-- base 10 logarithm of the operand, with the following cases:+--+-- * If the operand is a zero, the result is -Infinity and exact.+--+-- * If the operand is +Infinity, the result is +Infinity and exact.+--+-- * If the operand equals an integral power of ten (including 10^0 and+-- negative powers) and there is sufficient /precision/ to hold the integral+-- part of the result, the result is an integer (with an exponent of 0) and+-- exact.+--+-- * Otherwise the result is inexact and will be rounded using the+-- /round-half-even/ algorithm. The coefficient will have exactly /precision/+-- digits (unless the result is subnormal). These inexact results should be+-- correctly rounded, but may be up to 1 ulp (unit in last place) in error.+log10 :: FinitePrecision p => Decimal a b -> Arith p r (Decimal p RoundHalfEven)+log10 x@Num { sign = s, coefficient = c, exponent = e }+ | c == 0 = return infinity { sign = Neg }+ | s == Pos = getPrecision >>= \prec -> case powerOfTen c e of+ Just p | maybe True (numDigits pc <=) prec -> return (fromInteger p)+ where pc = fromInteger (Prelude.abs p) :: Coefficient+ _ -> subArith (join $ divide <$> ln x <*> ln10) >>= result++ where powerOfTen :: Coefficient -> Exponent -> Maybe Integer+ powerOfTen c e+ | c == 10^d = Just (fromIntegral e + fromIntegral d)+ | otherwise = Nothing+ where d = numDigits c - 1 :: Int++ result :: Decimal p a -> Arith p r (Decimal p a)+ result r = coerce <$> (raiseSignal Rounded =<< raiseSignal Inexact r')+ where r' = coerce r++log10 n@Inf { sign = Pos } = return (coerce n)+log10 n@QNaN{} = return (coerce n)+log10 n = coerce <$> invalidOperation n++{- $doctest-log10+>>> op1 Op.log10 "0"+-Infinity++>>> op1 Op.log10 "0.001"+-3++>>> op1 Op.log10 "1.000"+0++>>> op1 Op.log10 "2"+0.301029996++>>> op1 Op.log10 "10"+1++>>> op1 Op.log10 "70"+1.84509804++>>> op1 Op.log10 "+Infinity"+Infinity+-}++-- | 'divide' takes two operands. If either operand is a /special value/ then+-- the general rules apply.+-- -- Otherwise, if the divisor is zero then either the Division undefined -- condition is raised (if the dividend is zero) and the result is NaN, or the -- Division by zero condition is raised and the result is an Infinity with a@@ -318,7 +611,7 @@ divide dividend@Num{ sign = xs } Num { coefficient = 0, sign = ys } | Number.isZero dividend = invalidOperation qNaN | otherwise = raiseSignal DivisionByZero- infinity { sign = xorSigns xs ys }+ infinity { sign = xorSigns xs ys } divide Num { sign = xs, coefficient = xc, exponent = xe } Num { sign = ys, coefficient = yc, exponent = ye } = quotient @@ -329,7 +622,7 @@ re = xe - (ye + adjust) answer | rem == 0 = return rn- | otherwise = round $ case (rem * 2) `Prelude.compare` dv of+ | otherwise = roundDecimal $ case (rem * 2) `Prelude.compare` dv of LT -> rn { coefficient = rc * 10 + 1, exponent = re - 1 } EQ -> rn { coefficient = rc * 10 + 5, exponent = re - 1 } GT -> rn { coefficient = rc * 10 + 9, exponent = re - 1 }@@ -406,6 +699,10 @@ -> (Quotient, Remainder, Divisor, Exponent) step4 = (,,,) +reciprocal :: (FinitePrecision p, Rounding r)+ => Decimal a b -> Arith p r (Decimal p r)+reciprocal = divide one+ -- | 'abs' takes one operand. If the operand is negative, the result is the -- same as using the 'minus' operation on the operand. Otherwise, the result -- is the same as using the 'plus' operation on the operand.@@ -489,6 +786,17 @@ -1 -} +-- | 'compareSignal' takes two operands and compares their values+-- numerically. This operation is identical to 'compare', except that if+-- neither operand is a signaling NaN then any quiet NaN operand is treated as+-- though it were a signaling NaN. (That is, all NaNs signal, with signaling+-- NaNs taking precedence over quiet NaNs.)+compareSignal :: (Precision p, Rounding r)+ => Decimal a b -> Decimal c d -> Arith p r (Decimal p r)+compareSignal x@SNaN{} y = x `compare` y+compareSignal x y@SNaN{} = x `compare` y+compareSignal x y = quietToSignal x `compare` quietToSignal y+ -- | 'max' takes two operands, compares their values numerically, and returns -- the maximum. If either operand is a NaN then the general rules apply, -- unless one is a quiet NaN and the other is numeric, in which case the@@ -582,10 +890,195 @@ Num { sign = Neg } -> (x, y) nan -> let nan' = coerce nan in (nan', nan') - withoutSign :: Decimal p r -> Decimal p r withoutSign n = n { sign = Pos } +-- | 'power' takes two operands, and raises a number (the left-hand operand)+-- to a power (the right-hand operand). If either operand is a /special value/+-- then the general rules apply, except in certain cases.+power :: (FinitePrecision p, Rounding r)+ => Decimal a b -> Decimal c d -> Arith p r (Decimal p r)+power x@Num { coefficient = 0 } y@Num{}+ | Number.isZero y = invalidOperation qNaN+ | Number.isNegative y = return infinity { sign = powerSign x y }+ | otherwise = return zero { sign = powerSign x y }+power x@Num{} y@Num{} = case integralValue y of+ Just i | i < 0 -> reciprocal x >>= \rx -> integralPower rx (-i)+ | otherwise -> integralPower x i+ Nothing | Number.isPositive x -> ln x >>= multiply y >>= fmap coerce . exp+ | otherwise -> invalidOperation qNaN+power x@Num{} y@Inf{}+ | Number.isPositive x = return $ case sign y of+ Pos -> infinity+ Neg -> zero+ | otherwise = invalidOperation qNaN+power x@Inf{} y@Num{}+ | Number.isZero y = return one+ | Number.isPositive y = return infinity { sign = powerSign x y }+ | otherwise = return zero { sign = powerSign x y }+power Inf{} Inf { sign = s }+ | s == Pos = return infinity+ | otherwise = return zero+power x@SNaN{} _ = invalidOperation x+power _ y@SNaN{} = invalidOperation y+power x@QNaN{} _ = return (coerce x)+power _ y@QNaN{} = return (coerce y)++powerSign :: Decimal a b -> Decimal c d -> Sign+powerSign x y+ | Number.isNegative x && fromMaybe False (odd <$> integralValue y) = Neg+ | otherwise = Pos++integralPower :: (Precision p, Rounding r)+ => Decimal a b -> Integer -> Arith p r (Decimal p r)+integralPower b e = integralPower' (return b) e one+ where integralPower' :: (Precision p, Rounding r)+ => Arith p r (Decimal a b) -> Integer -> Decimal p r+ -> Arith p r (Decimal p r)+ integralPower' _ 0 r = return r+ integralPower' mb e r+ | odd e = mb >>= \b -> multiply r b >>=+ integralPower' (multiply b b) e'+ | otherwise = integralPower' (mb >>= \b -> multiply b b) e' r+ where e' = e `div` 2++{- $doctest-power+>>> op2 Op.power "2" "3"+8++>>> op2 Op.power "-2" "3"+-8++>>> op2 Op.power "2" "-3"+0.125++>>> op2 Op.power "1.7" "8"+69.7575744++>>> op2 Op.power "10" "0.301029996"+2.00000000++>>> op2 Op.power "Infinity" "-1"+0++>>> op2 Op.power "Infinity" "0"+1++>>> op2 Op.power "Infinity" "1"+Infinity++>>> op2 Op.power "-Infinity" "-1"+-0++>>> op2 Op.power "-Infinity" "0"+1++>>> op2 Op.power "-Infinity" "1"+-Infinity++>>> op2 Op.power "-Infinity" "2"+Infinity++>>> op2 Op.power "0" "0"+NaN+-}++-- | 'quantize' takes two operands. If either operand is a /special value/+-- then the general rules apply, except that if either operand is infinite and+-- the other is finite an Invalid operation condition is raised and the result+-- is NaN, or if both are infinite then the result is the first operand.+--+-- Otherwise (both operands are finite), 'quantize' returns the number which+-- is equal in value (except for any rounding) and sign to the first+-- (left-hand) operand and which has an /exponent/ set to be equal to the+-- exponent of the second (right-hand) operand.+--+-- The /coefficient/ of the result is derived from that of the left-hand+-- operand. It may be rounded using the current /rounding/ setting (if the+-- /exponent/ is being increased), multiplied by a positive power of ten (if+-- the /exponent/ is being decreased), or is unchanged (if the /exponent/ is+-- already equal to that of the right-hand operand).+--+-- Unlike other operations, if the length of the /coefficient/ after the+-- quantize operation would be greater than /precision/ then an Invalid+-- operation condition is raised. This guarantees that, unless there is an+-- error condition, the /exponent/ of the result of a quantize is always equal+-- to that of the right-hand operand.+--+-- Also unlike other operations, quantize will never raise Underflow, even if+-- the result is subnormal and inexact.+quantize :: (Precision p, Rounding r)+ => Decimal p r -> Decimal a b -> Arith p r (Decimal p r)+quantize x@Num { coefficient = xc, exponent = xe } Num { exponent = ye }+ | xe > ye = result x { coefficient = xc * 10^(xe - ye), exponent = ye }+ | xe < ye = rc >>= \c -> return x { coefficient = c, exponent = ye }+ | otherwise = return x++ where result :: Precision p => Decimal p r -> Arith p r (Decimal p r)+ result x = getPrecision >>= \p -> case numDigits (coefficient x) of+ n | maybe False (n >) p -> invalidOperation x+ _ -> return x++ rc :: Rounding r => Arith p r Coefficient+ rc = let b = 10^(ye - xe)+ (q, r) = xc `quotRem` b+ in getRounder >>= \rounder -> return (rounder (sign x) r b q)++quantize Num{} Inf{} = invalidOperation qNaN+quantize Inf{} Num{} = invalidOperation qNaN+quantize n@Inf{} Inf{} = return n+quantize n@SNaN{} _ = invalidOperation n+quantize _ n@SNaN{} = invalidOperation n+quantize n@QNaN{} _ = return n+quantize _ n@QNaN{} = return (coerce n)++{- $doctest-quantize+>>> op2 Op.quantize "2.17" "0.001"+2.170++>>> op2 Op.quantize "2.17" "0.01"+2.17++>>> op2 Op.quantize "2.17" "0.1"+2.2++>>> op2 Op.quantize "2.17" "1e+0"+2++>>> op2 Op.quantize "2.17" "1e+1"+0E+1++>>> op2 Op.quantize "-Inf" "Infinity"+-Infinity++>>> op2 Op.quantize "2" "Infinity"+NaN++>>> op2 Op.quantize "-0.1" "1"+-0++>>> op2 Op.quantize "-0" "1e+5"+-0E+5++>>> op2 Op.quantize "+35236450.6" "1e-2"+NaN++>>> op2 Op.quantize "-35236450.6" "1e-2"+NaN++>>> op2 Op.quantize "217" "1e-1"+217.0++>>> op2 Op.quantize "217" "1e+0"+217++>>> op2 Op.quantize "217" "1e+1"+2.2E+2++>>> op2 Op.quantize "217" "1e+2"+2E+2+-}+ -- | 'reduce' takes one operand. It has the same semantics as the 'plus' -- operation, except that if the final result is finite it is reduced to its -- simplest form, with all trailing zeros removed and its sign preserved.@@ -617,11 +1110,120 @@ 0 -} +-- | 'squareRoot' takes one operand. If the operand is a /special value/ then+-- the general rules apply.+--+-- Otherwise, the ideal exponent of the result is defined to be half the+-- exponent of the operand (rounded to an integer, towards -Infinity, if+-- necessary) and then:+--+-- If the operand is less than zero an Invalid operation condition is raised.+--+-- If the operand is greater than zero, the result is the square root of the+-- operand. If no rounding is necessary (the exact result requires /precision/+-- digits or fewer) then the the coefficient and exponent giving the correct+-- value and with the exponent closest to the ideal exponent is used. If the+-- result must be inexact, it is rounded using the /round-half-even/ algorithm+-- and the coefficient will have exactly /precision/ digits (unless the result+-- is subnormal), and the exponent will be set to maintain the correct value.+--+-- Otherwise (the operand is equal to zero), the result will be the zero with+-- the same sign as the operand and with the ideal exponent.+squareRoot :: FinitePrecision p+ => Decimal a b -> Arith p r (Decimal p RoundHalfEven)+squareRoot n@Num { sign = s, coefficient = c, exponent = e }+ | c == 0 = return n { exponent = idealExp }+ | s == Pos = subResult >>= subRounded >>= result++ where idealExp = e `div` 2 :: Exponent++ reduced :: Decimal p r -> Decimal p r+ reduced n@Num { coefficient = c, exponent = e }+ | e < idealExp = case bd of+ Just (b, (q, _)) -> n { coefficient = q, exponent = e + b }+ Nothing -> n+ | e > idealExp = n { coefficient = c * 10^d, exponent = idealExp }+ where d = Prelude.abs (e - idealExp)+ bd = find (\(_, (_, r)) -> r == 0) ds+ ds = map (\d -> (d, c `quotRem` (10^d))) [d, d - 1 .. 1]+ reduced n = n++ subResult :: FinitePrecision p+ => Arith p r (Decimal (PPlus1 (PPlus1 p)) RoundHalfEven)+ subResult = subArith (babylonian approx)++ subRounded :: Precision p+ => Decimal a b -> Arith p r (Decimal p RoundHalfEven)+ subRounded = subArith . roundDecimal++ exactness :: Decimal a b -> Arith p r (Decimal PInfinite RoundHalfEven)+ exactness r = subArith (multiply r r >>= compare n)++ result :: Decimal p a -> Arith p r (Decimal p a)+ result r = do+ e <- exactness r+ if Number.isZero e+ then return (reduced r)+ else let r' = coerce r+ in coerce <$> (raiseSignal Rounded =<< raiseSignal Inexact r')++ approx :: Decimal p r+ approx | even ae = n { coefficient = 2, exponent = ae `quot` 2 }+ | otherwise = n { coefficient = 6, exponent = (ae - 1) `quot` 2 }+ where ae = adjustedExponent n++ babylonian :: FinitePrecision p => Decimal p RoundHalfEven+ -> Arith p RoundHalfEven (Decimal p RoundHalfEven)+ babylonian x = do+ x' <- multiply oneHalf =<< add x =<< n `divide` x+ if x' == x then return x' else babylonian x'++squareRoot n@Inf { sign = Pos } = return (coerce n)+squareRoot n@QNaN{} = return (coerce n)+squareRoot n = coerce <$> invalidOperation n++{- $doctest-squareRoot+>>> op1 Op.squareRoot "0"+0++>>> op1 Op.squareRoot "-0"+-0++This example appears to contradict the specification that the resulting+coefficient will have exactly /precision/ digits; awaiting clarification.+<<< op1 Op.squareRoot "0.39"+0.62449980++>>> op1 Op.squareRoot "100"+10++>>> op1 Op.squareRoot "1"+1++>>> op1 Op.squareRoot "1.0"+1.0++>>> op1 Op.squareRoot "1.00"+1.0++>>> op1 Op.squareRoot "7"+2.64575131++>>> op1 Op.squareRoot "10"+3.16227766+-}+ -- $miscellaneous-operations -- -- This section describes miscellaneous operations on decimal numbers, -- including non-numeric comparisons, sign and other manipulations, and -- logical operations.+--+-- Some operations return a boolean value that is described as 0 or 1 in the+-- documentation below. For reasons of efficiency, and as permitted by the+-- /General Decimal Arithmetic Specification/, these operations return a+-- 'Bool' in this implementation, but can be converted to 'Decimal' via+-- 'fromBool'. -- | 'canonical' takes one operand. The result has the same value as the -- operand but always uses a /canonical/ encoding. The definition of@@ -656,36 +1258,47 @@ -- ignored in the classification, as required by IEEE 754. class_ :: Precision a => Decimal a b -> Arith p r Class class_ n = return $ case n of- Num {} | Number.isZero n -> Class (sign n) ZeroClass- | Number.isSubnormal n -> Class (sign n) SubnormalClass- | otherwise -> Class (sign n) NormalClass- Inf {} -> Class (sign n) InfinityClass- QNaN{} -> Class Pos NaNClass- SNaN{} -> Class Neg NaNClass+ Num {} | Number.isZero n -> NumberClass (sign n) ZeroClass+ | Number.isSubnormal n -> NumberClass (sign n) SubnormalClass+ | otherwise -> NumberClass (sign n) NormalClass+ Inf {} -> NumberClass (sign n) InfinityClass+ QNaN{} -> NaNClass QNaNClass+ SNaN{} -> NaNClass SNaNClass -data Class = Class Sign Subclass deriving Eq+data Class = NumberClass Sign NumberClass -- ^ Number (finite or infinite)+ | NaNClass NaNClass -- ^ Not a number (quiet or signaling)+ deriving Eq -data Subclass = ZeroClass -- ^ Zero- | NormalClass -- ^ Normal finite number- | SubnormalClass -- ^ Subnormal finite number- | InfinityClass -- ^ Infinity- | NaNClass -- ^ Not a number (quiet or signaling)+data NumberClass = ZeroClass -- ^ Zero+ | SubnormalClass -- ^ Subnormal finite number+ | NormalClass -- ^ Normal finite number+ | InfinityClass -- ^ Infinity+ deriving Eq++data NaNClass = QNaNClass -- ^ Not a number (quiet)+ | SNaNClass -- ^ Not a number (signaling) deriving Eq instance Show Class where show c = case c of- Class Pos s@NaNClass -> showSubclass s- Class Neg s@NaNClass -> 's' : showSubclass s- Class Pos s -> '+' : showSubclass s- Class Neg s -> '-' : showSubclass s+ NumberClass s nc -> signChar s : showNumberClass nc+ NaNClass QNaNClass -> nan+ NaNClass SNaNClass -> 's' : nan - where showSubclass s = case s of+ where signChar :: Sign -> Char+ signChar Pos = '+'+ signChar Neg = '-'++ showNumberClass :: NumberClass -> String+ showNumberClass s = case s of ZeroClass -> "Zero"- NormalClass -> "Normal" SubnormalClass -> "Subnormal"+ NormalClass -> "Normal" InfinityClass -> "Infinity"- NaNClass -> "NaN" + nan :: String+ nan = "NaN"+ {- $doctest-class_ >>> op1 Op.class_ "Infinity" +Infinity@@ -801,11 +1414,11 @@ -- If all possible operands have just one internal encoding each, then -- 'isCanonical' always returns 1. This operation is unaffected by context and -- is quiet – no /flags/ are changed in the context.-isCanonical :: Decimal a b -> Arith p r (Decimal p r)-isCanonical _ = return one+isCanonical :: Decimal a b -> Arith p r Bool+isCanonical _ = return True {- $doctest-isCanonical->>> op1 Op.isCanonical "2.50"+>>> fromBool $ op1 Op.isCanonical "2.50" 1 -} @@ -813,193 +1426,216 @@ -- infinite nor a NaN (that is, it is a normal number, a subnormal number, or -- a zero); otherwise it is 0. This operation is unaffected by context and is -- quiet – no /flags/ are changed in the context.-isFinite :: Decimal a b -> Arith p r (Decimal p r)-isFinite n = return $ case n of- Num{} -> one- _ -> zero+isFinite :: Decimal a b -> Arith p r Bool+isFinite = return . Number.isFinite {- $doctest-isFinite->>> op1 Op.isFinite "2.50"+>>> fromBool $ op1 Op.isFinite "2.50" 1 ->>> op1 Op.isFinite "-0.3"+>>> fromBool $ op1 Op.isFinite "-0.3" 1 ->>> op1 Op.isFinite "0"+>>> fromBool $ op1 Op.isFinite "0" 1 ->>> op1 Op.isFinite "Inf"+>>> fromBool $ op1 Op.isFinite "Inf" 0 ->>> op1 Op.isFinite "NaN"+>>> fromBool $ op1 Op.isFinite "NaN" 0 -} -- | 'isInfinite' takes one operand. The result is 1 if the operand is an -- Infinity; otherwise it is 0. This operation is unaffected by context and is -- quiet – no /flags/ are changed in the context.-isInfinite :: Decimal a b -> Arith p r (Decimal p r)+isInfinite :: Decimal a b -> Arith p r Bool isInfinite n = return $ case n of- Inf{} -> one- _ -> zero+ Inf{} -> True+ _ -> False {- $doctest-isInfinite->>> op1 Op.isInfinite "2.50"+>>> fromBool $ op1 Op.isInfinite "2.50" 0 ->>> op1 Op.isInfinite "-Inf"+>>> fromBool $ op1 Op.isInfinite "-Inf" 1 ->>> op1 Op.isInfinite "NaN"+>>> fromBool $ op1 Op.isInfinite "NaN" 0 -} -- | 'isNaN' takes one operand. The result is 1 if the operand is a NaN (quiet -- or signaling); otherwise it is 0. This operation is unaffected by context -- and is quiet – no /flags/ are changed in the context.-isNaN :: Decimal a b -> Arith p r (Decimal p r)+isNaN :: Decimal a b -> Arith p r Bool isNaN n = return $ case n of- QNaN{} -> one- SNaN{} -> one- _ -> zero+ QNaN{} -> True+ SNaN{} -> True+ _ -> False {- $doctest-isNaN->>> op1 Op.isNaN "2.50"+>>> fromBool $ op1 Op.isNaN "2.50" 0 ->>> op1 Op.isNaN "NaN"+>>> fromBool $ op1 Op.isNaN "NaN" 1 ->>> op1 Op.isNaN "-sNaN"+>>> fromBool $ op1 Op.isNaN "-sNaN" 1 -} -- | 'isNormal' takes one operand. The result is 1 if the operand is a -- positive or negative /normal number/; otherwise it is 0. This operation is -- quiet; no /flags/ are changed in the context.-isNormal :: Precision a => Decimal a b -> Arith p r (Decimal p r)-isNormal n = return $ case n of- _ | Number.isNormal n -> one- | otherwise -> zero+isNormal :: Precision a => Decimal a b -> Arith p r Bool+isNormal = return . Number.isNormal {- $doctest-isNormal->>> op1 Op.isNormal "2.50"+>>> fromBool $ op1 Op.isNormal "2.50" 1 ->>> op1 Op.isNormal "0.1E-999"+>>> fromBool $ op1 Op.isNormal "0.1E-999" 0 ->>> op1 Op.isNormal "0.00"+>>> fromBool $ op1 Op.isNormal "0.00" 0 ->>> op1 Op.isNormal "-Inf"+>>> fromBool $ op1 Op.isNormal "-Inf" 0 ->>> op1 Op.isNormal "NaN"+>>> fromBool $ op1 Op.isNormal "NaN" 0 -} -- | 'isQNaN' takes one operand. The result is 1 if the operand is a quiet -- NaN; otherwise it is 0. This operation is unaffected by context and is -- quiet – no /flags/ are changed in the context.-isQNaN :: Decimal a b -> Arith p r (Decimal p r)+isQNaN :: Decimal a b -> Arith p r Bool isQNaN n = return $ case n of- QNaN{} -> one- _ -> zero+ QNaN{} -> True+ _ -> False {- $doctest-isQNaN->>> op1 Op.isQNaN "2.50"+>>> fromBool $ op1 Op.isQNaN "2.50" 0 ->>> op1 Op.isQNaN "NaN"+>>> fromBool $ op1 Op.isQNaN "NaN" 1 ->>> op1 Op.isQNaN "sNaN"+>>> fromBool $ op1 Op.isQNaN "sNaN" 0 -} -- | 'isSigned' takes one operand. The result is 1 if the /sign/ of the -- operand is 1; otherwise it is 0. This operation is unaffected by context -- and is quiet – no /flags/ are changed in the context.-isSigned :: Decimal a b -> Arith p r (Decimal p r)-isSigned n = return $ case sign n of- Neg -> one- Pos -> zero+isSigned :: Decimal a b -> Arith p r Bool+isSigned = return . Number.isNegative {- $doctest-isSigned->>> op1 Op.isSigned "2.50"+>>> fromBool $ op1 Op.isSigned "2.50" 0 ->>> op1 Op.isSigned "-12"+>>> fromBool $ op1 Op.isSigned "-12" 1 ->>> op1 Op.isSigned "-0"+>>> fromBool $ op1 Op.isSigned "-0" 1 -} -- | 'isSNaN' takes one operand. The result is 1 if the operand is a signaling -- NaN; otherwise it is 0. This operation is unaffected by context and is -- quiet – no /flags/ are changed in the context.-isSNaN :: Decimal a b -> Arith p r (Decimal p r)+isSNaN :: Decimal a b -> Arith p r Bool isSNaN n = return $ case n of- SNaN{} -> one- _ -> zero+ SNaN{} -> True+ _ -> False {- $doctest-isSNaN->>> op1 Op.isSNaN "2.50"+>>> fromBool $ op1 Op.isSNaN "2.50" 0 ->>> op1 Op.isSNaN "NaN"+>>> fromBool $ op1 Op.isSNaN "NaN" 0 ->>> op1 Op.isSNaN "sNaN"+>>> fromBool $ op1 Op.isSNaN "sNaN" 1 -} -- | 'isSubnormal' takes one operand. The result is 1 if the operand is a -- positive or negative /subnormal number/; otherwise it is 0. This operation -- is quiet; no /flags/ are changed in the context.-isSubnormal :: Precision a => Decimal a b -> Arith p r (Decimal p r)-isSubnormal n = return $ case n of- _ | Number.isSubnormal n -> one- | otherwise -> zero+isSubnormal :: Precision a => Decimal a b -> Arith p r Bool+isSubnormal = return . Number.isSubnormal {- $doctest-isSubnormal->>> op1 Op.isSubnormal "2.50"+>>> fromBool $ op1 Op.isSubnormal "2.50" 0 ->>> op1 Op.isSubnormal "0.1E-999"+>>> fromBool $ op1 Op.isSubnormal "0.1E-999" 1 ->>> op1 Op.isSubnormal "0.00"+>>> fromBool $ op1 Op.isSubnormal "0.00" 0 ->>> op1 Op.isSubnormal "-Inf"+>>> fromBool $ op1 Op.isSubnormal "-Inf" 0 ->>> op1 Op.isSubnormal "NaN"+>>> fromBool $ op1 Op.isSubnormal "NaN" 0 -} -- | 'isZero' takes one operand. The result is 1 if the operand is a zero; -- otherwise it is 0. This operation is unaffected by context and is quiet – -- no /flags/ are changed in the context.-isZero :: Decimal a b -> Arith p r (Decimal p r)-isZero n = return $ case n of- _ | Number.isZero n -> one- | otherwise -> zero+isZero :: Decimal a b -> Arith p r Bool+isZero = return . Number.isZero {- $doctest-isZero->>> op1 Op.isZero "0"+>>> fromBool $ op1 Op.isZero "0" 1 ->>> op1 Op.isZero "2.50"+>>> fromBool $ op1 Op.isZero "2.50" 0 ->>> op1 Op.isZero "-0E+2"+>>> fromBool $ op1 Op.isZero "-0E+2" 1 -} +-- | 'logb' takes one operand. If the operand is a NaN then the general+-- arithmetic rules apply. If the operand is infinite then +Infinity is+-- returned. If the operand is a zero, then -Infinity is returned and the+-- Division by zero exceptional condition is raised.+--+-- Otherwise, the result is the integer which is the exponent of the magnitude+-- of the most significant digit of the operand (as though the operand were+-- truncated to a single digit while maintaining the value of that digit and+-- without limiting the resulting exponent). All results are exact unless an+-- integer result does not fit in the available /precision/.+logb :: (Precision p, Rounding r) => Decimal a b -> Arith p r (Decimal p r)+logb Num { coefficient = c, exponent = e }+ | c == 0 = raiseSignal DivisionByZero Inf { sign = Neg }+ | otherwise = roundDecimal (fromInteger r :: Decimal PInfinite RoundHalfEven)+ where r = fromIntegral (numDigits c) - 1 + fromIntegral e :: Integer+logb Inf{} = return Inf { sign = Pos }+logb n@QNaN{} = return (coerce n)+logb n@SNaN{} = invalidOperation n++{- $doctest-logb+>>> op1 Op.logb "250"+2++>>> op1 Op.logb "2.50"+0++>>> op1 Op.logb "0.03"+-2++>>> op1 Op.logb "0"+-Infinity+-}+ -- | 'radix' takes no operands. The result is the radix (base) in which -- arithmetic is effected; for this specification the result will have the -- value 10.@@ -1022,33 +1658,83 @@ -- are NaNs or both are infinities. -- -- 'sameQuantum' does not change any /flags/ in the context.-sameQuantum :: Decimal a b -> Decimal c d -> Arith p r (Decimal p r)+sameQuantum :: Decimal a b -> Decimal c d -> Arith p r Bool sameQuantum Num { exponent = e1 } Num { exponent = e2 }- | e1 == e2 = return one- | otherwise = return zero-sameQuantum Inf {} Inf {} = return one-sameQuantum QNaN{} QNaN{} = return one-sameQuantum SNaN{} SNaN{} = return one-sameQuantum QNaN{} SNaN{} = return one-sameQuantum SNaN{} QNaN{} = return one-sameQuantum _ _ = return zero+ | e1 == e2 = return True+ | otherwise = return False+sameQuantum Inf {} Inf {} = return True+sameQuantum QNaN{} QNaN{} = return True+sameQuantum SNaN{} SNaN{} = return True+sameQuantum QNaN{} SNaN{} = return True+sameQuantum SNaN{} QNaN{} = return True+sameQuantum _ _ = return False {- $doctest-sameQuantum->>> op2 Op.sameQuantum "2.17" "0.001"+>>> fromBool $ op2 Op.sameQuantum "2.17" "0.001" 0 ->>> op2 Op.sameQuantum "2.17" "0.01"+>>> fromBool $ op2 Op.sameQuantum "2.17" "0.01" 1 ->>> op2 Op.sameQuantum "2.17" "0.1"+>>> fromBool $ op2 Op.sameQuantum "2.17" "0.1" 0 ->>> op2 Op.sameQuantum "2.17" "1"+>>> fromBool $ op2 Op.sameQuantum "2.17" "1" 0 ->>> op2 Op.sameQuantum "Inf" "-Inf"+>>> fromBool $ op2 Op.sameQuantum "Inf" "-Inf" 1 ->>> op2 Op.sameQuantum "NaN" "NaN"+>>> fromBool $ op2 Op.sameQuantum "NaN" "NaN" 1+-}++-- | 'shift' takes two operands. The second operand must be an integer (with+-- an /exponent/ of 0) in the range /-precision/ through /precision/. If the+-- first operand is a NaN then the general arithmetic rules apply, and if it+-- is infinite then the result is the Infinity unchanged.+--+-- Otherwise (the first operand is finite) the result has the same /sign/ and+-- /exponent/ as the first operand, and a /coefficient/ which is a shifted+-- copy of the digits in the coefficient of the first operand. The number of+-- places to shift is taken from the absolute value of the second operand,+-- with the shift being to the left if the second operand is positive or to+-- the right otherwise. Digits shifted into the coefficient are zeros.+--+-- The only /flag/ that might be set is /invalid-operation/ (set if the first+-- operand is an sNaN or the second is not valid).+--+-- The 'rotate' operation can be used to rotate rather than shift a+-- coefficient.+shift :: Precision p => Decimal p a -> Decimal b c -> Arith p r (Decimal p a)+shift n@Num { coefficient = c } s@Num { sign = d, coefficient = sc }+ | validShift n s = return $ case d of+ Pos -> case precision n of+ Just p -> n { coefficient = (c * 10 ^ sc) `rem` 10 ^ p }+ Nothing -> n { coefficient = c * 10 ^ sc }+ Neg -> n { coefficient = c `quot` 10 ^ sc }+shift n@Inf{} s | validShift n s = return n+shift n@QNaN{} s | validShift n s = return n+shift n _ = coerce <$> invalidOperation n++validShift :: Precision p => Decimal p a -> Decimal b c -> Bool+validShift n Num { coefficient = c, exponent = 0 } =+ let p = fromIntegral <$> precision n in maybe True (c <=) p+validShift _ _ = False++{- $doctest-shift+>>> op2 Op.shift "34" "8"+400000000++>>> op2 Op.shift "12" "9"+0++>>> op2 Op.shift "123456789" "-2"+1234567++>>> op2 Op.shift "123456789" "0"+123456789++>>> op2 Op.shift "123456789" "+2"+345678900 -}
src/Numeric/Decimal/Operation.hs-boot view
@@ -5,14 +5,19 @@ , subtract , multiply , divide+ , exp+ , ln+ , log10 , minus , abs , compare , min , max+ , power+ , squareRoot ) where -import Prelude hiding (abs, compare, max, min, subtract)+import Prelude hiding (abs, compare, exp, max, min, subtract) import {-# SOURCE #-} Numeric.Decimal.Arithmetic import {-# SOURCE #-} Numeric.Decimal.Number@@ -27,6 +32,12 @@ => Decimal a b -> Decimal c d -> Arith p r (Decimal p r) divide :: (FinitePrecision p, Rounding r) => Decimal a b -> Decimal c d -> Arith p r (Decimal p r)+exp :: FinitePrecision p+ => Decimal a b -> Arith p r (Decimal p RoundHalfEven)+ln :: FinitePrecision p+ => Decimal a b -> Arith p r (Decimal p RoundHalfEven)+log10 :: FinitePrecision p+ => Decimal a b -> Arith p r (Decimal p RoundHalfEven) minus :: (Precision p, Rounding r) => Decimal a b -> Arith p r (Decimal p r) abs :: (Precision p, Rounding r)@@ -37,3 +48,7 @@ => Decimal a b -> Decimal a b -> Arith p r (Decimal a b) max :: (Precision p, Rounding r) => Decimal a b -> Decimal a b -> Arith p r (Decimal a b)+power :: (FinitePrecision p, Rounding r)+ => Decimal a b -> Decimal c d -> Arith p r (Decimal p r)+squareRoot :: FinitePrecision p+ => Decimal a b -> Arith p r (Decimal p RoundHalfEven)
src/Numeric/Decimal/Precision.hs view
@@ -11,8 +11,7 @@ , P75, P100, P150, P200, P250, P300, P400, P500, P1000, P2000 - , PPlus1, PPlus2, PPlus3, PPlus4, PPlus5, PPlus6, PPlus7, PPlus8, PPlus9- , PTimes2, PTimes10+ , PPlus1, PTimes2 , PInfinite ) where@@ -37,43 +36,25 @@ precision _ = Just 1 instance FinitePrecision P1 --- | A precision of (@p@ + @q@) significant digits-data PPlus p q-instance (Precision p, Precision q) => Precision (PPlus p q) where- precision pq = (+) <$> precision (p pq) <*> precision (q pq)- where p :: PPlus p q -> p- p = undefined- q :: PPlus p q -> q- q = undefined-instance (FinitePrecision p, FinitePrecision q) => FinitePrecision (PPlus p q)---- | A precision of (@p@ × @q@) significant digits-data PTimes p q-instance (Precision p, Precision q) => Precision (PTimes p q) where- precision pq = (*) <$> precision (p pq) <*> precision (q pq)- where p :: PTimes p q -> p- p = undefined- q :: PTimes p q -> q- q = undefined-instance (FinitePrecision p, FinitePrecision q) => FinitePrecision (PTimes p q)--type PPlus1 p = PPlus p P1 -- ^ A precision of (@p@ + 1) significant digits-type PPlus2 p = PPlus p P2 -- ^ A precision of (@p@ + 2) significant digits-type PPlus3 p = PPlus p P3 -- ^ A precision of (@p@ + 3) significant digits-type PPlus4 p = PPlus p P4 -- ^ A precision of (@p@ + 4) significant digits-type PPlus5 p = PPlus p P5 -- ^ A precision of (@p@ + 5) significant digits-type PPlus6 p = PPlus p P6 -- ^ A precision of (@p@ + 6) significant digits-type PPlus7 p = PPlus p P7 -- ^ A precision of (@p@ + 7) significant digits-type PPlus8 p = PPlus p P8 -- ^ A precision of (@p@ + 8) significant digits-type PPlus9 p = PPlus p P9 -- ^ A precision of (@p@ + 9) significant digits+-- | A precision of (@p@ + 1) significant digits+data PPlus1 p+instance Precision p => Precision (PPlus1 p) where+ precision pp = (+ 1) <$> precision (minus1 pp)+ where minus1 :: PPlus1 p -> p+ minus1 = undefined+instance FinitePrecision p => FinitePrecision (PPlus1 p) -type PTimes2 = PTimes P2-type PTimes10 = PTimes P10+-- | A precision of (@p@ × 2) significant digits+data PTimes2 p+instance Precision p => Precision (PTimes2 p) where+ precision pp = (* 2) <$> precision (div2 pp)+ where div2 :: PTimes2 p -> p+ div2 = undefined+instance FinitePrecision p => FinitePrecision (PTimes2 p) -- | A precision of 2 significant digits-type P2 = PPlus1 P1--- | A precision of 3 significant digits-type P3 = PPlus1 P2+type P2 = PTimes2 P1 ; type P3 = PPlus1 P2+-- ^ A precision of 3 significant digits -- | Et cetera type P4 = PTimes2 P2 ; type P5 = PPlus1 P4@@ -101,13 +82,15 @@ type P48 = PTimes2 P24; type P49 = PPlus1 P48 type P50 = PTimes2 P25-type P75 = PPlus5 (PTimes10 P7)+type P62 = PTimes2 P31+type P74 = PTimes2 P37; type P75 = PPlus1 P74 type P100 = PTimes2 P50+type P124 = PTimes2 P62; type P125 = PPlus1 P124 type P150 = PTimes2 P75 type P200 = PTimes2 P100-type P250 = PTimes10 P25+type P250 = PTimes2 P125 type P300 = PTimes2 P150 type P400 = PTimes2 P200
src/Numeric/Decimal/Rounding.hs view
@@ -12,14 +12,20 @@ , RoundHalfDown , RoundUp , Round05Up++ , getRounder+ , roundDecimal ) where import Prelude hiding (exponent) +import Data.Coerce (coerce)+ import {-# SOURCE #-} Numeric.Decimal.Number import Numeric.Decimal.Precision import {-# SOURCE #-} Numeric.Decimal.Arithmetic +-- | A value representation of a rounding algorithm (cf. 'Rounding'). data RoundingAlgorithm = RoundDown | RoundHalfUp | RoundHalfEven@@ -28,167 +34,143 @@ | RoundHalfDown | RoundUp | Round05Up- deriving (Eq, Enum)+ deriving Eq -- | A rounding algorithm to use when the result of an arithmetic operation -- exceeds the precision of the result type class Rounding r where- rounding :: r -> RoundingAlgorithm- round :: Precision p => Decimal p r -> Arith p r (Decimal p r)+ rounding :: r -> RoundingAlgorithm+ roundCoefficient :: r -> Rounder --- Required...+type Remainder = Coefficient+type Divisor = Coefficient --- | Round toward 0 (truncate)+type Rounder = Sign -> Remainder -> Divisor -> Coefficient -> Coefficient++getRounder :: Rounding r => Arith p r Rounder+getRounder = ($ undefined) <$> getRounder'+ where getRounder' :: Rounding r => Arith p r (r -> Rounder)+ getRounder' = return roundCoefficient++-- | Round a 'Decimal' to the precision of the arithmetic context using the+-- rounding algorithm of the arithmetic context.+roundDecimal :: (Precision p, Rounding r)+ => Decimal a b -> Arith p r (Decimal p r)+roundDecimal n@Num { sign = s, coefficient = c, exponent = e } = do+ p <- getPrecision+ case excessDigits c =<< p of+ Just d -> do+ rounder <- getRounder+ let b = 10 ^ d+ (q, r) = c `quotRem` b+ c' = rounder s r b q+ e' = e + fromIntegral d+ n' = case excessDigits c' =<< p of+ Nothing -> n { coefficient = c' , exponent = e' }+ _ -> n { coefficient = c' `quot` 10, exponent = succ e' }+ rounded :: Decimal p r -> Arith p r (Decimal p r)+ rounded+ | r /= 0 = raiseSignal Inexact+ | otherwise = return+ raiseSignal Rounded =<< rounded n' -- XXX check for overflow++ Nothing -> return (coerce n)++ where excessDigits :: Coefficient -> Int -> Maybe Int+ excessDigits c p | d > p = Just (d - p)+ | otherwise = Nothing+ where d = numDigits c :: Int++roundDecimal n = return (coerce n)++-- Required algorithms...++-- | (Round toward 0; truncate.) The discarded digits are ignored; the result+-- is unchanged. data RoundDown instance Rounding RoundDown where rounding _ = RoundDown- round = roundDown + roundCoefficient _ _ _ _ = id+ -- | If the discarded digits represent greater than or equal to half (0.5) of--- the value of a one in the next left position then the value is rounded--- up. If they represent less than half, the value is rounded down.+-- the value of a one in the next left position then the result coefficient+-- should be incremented by 1 (rounded up). Otherwise the discarded digits are+-- ignored. data RoundHalfUp instance Rounding RoundHalfUp where rounding _ = RoundHalfUp- round = roundHalfUp --- | If the discarded digits represent greater than half (0.5) of the value of--- a one in the next left position then the value is rounded up. If they--- represent less than half, the value is rounded down. If they represent--- exactly half, the value is rounded to make its rightmost digit even.+ roundCoefficient _ _ r v | r * 2 >= v = succ+ | otherwise = id++-- | If the discarded digits represent greater than half (0.5) the value of a+-- one in the next left position then the result coefficient should be+-- incremented by 1 (rounded up). If they represent less than half, then the+-- result coefficient is not adjusted (that is, the discarded digits are+-- ignored).+--+-- Otherwise (they represent exactly half) the result coefficient is unaltered+-- if its rightmost digit is even, or incremented by 1 (rounded up) if its+-- rightmost digit is odd (to make an even digit). data RoundHalfEven instance Rounding RoundHalfEven where rounding _ = RoundHalfEven- round = roundHalfEven --- | Round toward +∞+ roundCoefficient _ _ r v q = case (r * 2) `Prelude.compare` v of+ GT -> succ q+ EQ | odd q -> succ q+ _ -> q++-- | (Round toward +∞.) If all of the discarded digits are zero or if the+-- /sign/ is 1 the result is unchanged. Otherwise, the result coefficient+-- should be incremented by 1 (rounded up). data RoundCeiling instance Rounding RoundCeiling where rounding _ = RoundCeiling- round = roundCeiling --- | Round toward −∞+ roundCoefficient _ Pos r _ | r /= 0 = succ+ roundCoefficient _ _ _ _ = id++-- | (Round toward −∞.) If all of the discarded digits are zero or if the+-- /sign/ is 0 the result is unchanged. Otherwise, the sign is 1 and the+-- result coefficient should be incremented by 1. data RoundFloor instance Rounding RoundFloor where rounding _ = RoundFloor- round = roundFloor --- Optional...+ roundCoefficient _ Neg r _ | r /= 0 = succ+ roundCoefficient _ _ _ _ = id +-- Optional algorithms...+ -- | If the discarded digits represent greater than half (0.5) of the value of--- a one in the next left position then the value is rounded up. If they--- represent less than half or exactly half, the value is rounded down.+-- a one in the next left position then the result coefficient should be+-- incremented by 1 (rounded up). Otherwise (the discarded digits are 0.5 or+-- less) the discarded digits are ignored. data RoundHalfDown instance Rounding RoundHalfDown where rounding _ = RoundHalfDown- round = roundHalfDown --- | Round away from 0+ roundCoefficient _ _ r v | r * 2 > v = succ+ | otherwise = id++-- | (Round away from 0.) If all of the discarded digits are zero the result+-- is unchanged. Otherwise, the result coefficient should be incremented by 1+-- (rounded up). data RoundUp instance Rounding RoundUp where rounding _ = RoundUp- round = roundUp --- | Round zero or five away from 0+ roundCoefficient _ _ r _ | r /= 0 = succ+ | otherwise = id++-- | (Round zero or five away from 0.) The same as 'RoundUp', except that+-- rounding up only occurs if the digit to be rounded up is 0 or 5, and after+-- overflow the result is the same as for 'RoundDown'. data Round05Up instance Rounding Round05Up where rounding _ = Round05Up- round = round05Up --- Implementations--excessDigits :: Precision p => Decimal p r -> Arith p r (Maybe Int)-excessDigits n@Num { coefficient = c } = result- where result = return (precision n >>= excess)- d = numDigits c- excess p- | d > p = Just (d - p)- | otherwise = Nothing-excessDigits _ = return Nothing--rounded :: (Coefficient -> Coefficient -> Coefficient ->- Decimal p r -> Decimal p r -> Decimal p r)- -> Int -> Decimal p r -> Arith p r (Decimal p r)-rounded f d n = raiseSignal Rounded =<< rounded' n'- where rounded'- | r /= 0 = raiseSignal Inexact- | otherwise = return- p = 10 ^ d- (q, r) = coefficient n `quotRem` p- n' = f (p `quot` 2) q r down up- down = n { coefficient = q , exponent = exponent n + fromIntegral d }- up = n { coefficient = q + 1, exponent = exponent n + fromIntegral d }--roundDown :: Precision p => Decimal p r -> Arith p r (Decimal p r)-roundDown n = excessDigits n >>= roundDown'- where roundDown' Nothing = return n- roundDown' (Just d) = rounded choice d n-- choice _h _q _r down _up = down--roundHalfUp :: Precision p => Decimal p r -> Arith p r (Decimal p r)-roundHalfUp n = excessDigits n >>= roundHalfUp'- where roundHalfUp' Nothing = return n- roundHalfUp' (Just d) = rounded choice d n-- choice h _q r down up- | r >= h = up- | otherwise = down--roundHalfEven :: Precision p => Decimal p r -> Arith p r (Decimal p r)-roundHalfEven n = excessDigits n >>= roundHalfEven'- where roundHalfEven' Nothing = return n- roundHalfEven' (Just d) = rounded choice d n-- choice h q r down up = case r `Prelude.compare` h of- LT -> down- GT -> up- EQ | even q -> down- | otherwise -> up--roundCeiling :: Precision p => Decimal p r -> Arith p r (Decimal p r)-roundCeiling n = excessDigits n >>= roundCeiling'- where roundCeiling' Nothing = return n- roundCeiling' (Just d) = rounded choice d n-- choice _h _q r down up- | r == 0 || sign n == Neg = down- | otherwise = up--roundFloor :: Precision p => Decimal p r -> Arith p r (Decimal p r)-roundFloor n = excessDigits n >>= roundFloor'- where roundFloor' Nothing = return n- roundFloor' (Just d) = rounded choice d n-- choice _h _q r down up- | r == 0 || sign n == Pos = down- | otherwise = up--roundHalfDown :: Precision p => Decimal p r -> Arith p r (Decimal p r)-roundHalfDown n = excessDigits n >>= roundHalfDown'- where roundHalfDown' Nothing = return n- roundHalfDown' (Just d) = rounded choice d n-- choice h _q r down up- | r > h = up- | otherwise = down--roundUp :: Precision p => Decimal p r -> Arith p r (Decimal p r)-roundUp n = excessDigits n >>= roundUp'- where roundUp' Nothing = return n- roundUp' (Just d) = rounded choice d n-- choice _h _q r down up- | r == 0 = down- | otherwise = up--round05Up :: Precision p => Decimal p r -> Arith p r (Decimal p r)-round05Up n = excessDigits n >>= round05Up'- where round05Up' Nothing = return n- round05Up' (Just d) = rounded choice d n-- choice _h q r down up- | r == 0 = down- | d == 0 || d == 5 = up -- XXX overflow -> roundDown?- | otherwise = down- where d = q `rem` 10+ roundCoefficient _ _ r _ q | r /= 0 && rem q 10 `elem` [0, 5] = succ q+ | otherwise = q
stack.yaml view
@@ -1,13 +1,44 @@-# This file was automatically generated by stack init-# For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration/+# This file was automatically generated by 'stack init'+# +# Some commonly used options have been documented as comments in this file.+# For advanced use and comprehensive documentation of the format, please see:+# http://docs.haskellstack.org/en/stable/yaml_configuration/ -# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)-resolver: lts-5.15+# Resolver to choose a 'specific' stackage snapshot or a compiler version.+# A snapshot resolver dictates the compiler version and the set of packages+# to be used for project dependencies. For example:+# +# resolver: lts-3.5+# resolver: nightly-2015-09-21+# resolver: ghc-7.10.2+# resolver: ghcjs-0.1.0_ghc-7.10.2+# resolver:+# name: custom-snapshot+# location: "./custom-snapshot.yaml"+resolver: lts-6.9 -# Local packages, usually specified by relative directory name+# User packages to be built.+# Various formats can be used as shown in the example below.+# +# packages:+# - some-directory+# - https://example.com/foo/bar/baz-0.0.2.tar.gz+# - location:+# git: https://github.com/commercialhaskell/stack.git+# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a+# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a+# extra-dep: true+# subdirs:+# - auto-update+# - wai+# +# A package marked 'extra-dep: true' will only be built if demanded by a+# non-dependency (i.e. a user package), and its test suites and benchmarks+# will not be run. This is useful for tweaking upstream packages. packages: - '.'-# Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3)+# Dependency packages to be pulled from upstream that are not in the resolver+# (e.g., acme-missiles-0.3) extra-deps: [] # Override default flag values for local packages and extra-deps@@ -18,18 +49,18 @@ # Control whether we use the GHC we find on the path # system-ghc: true-+# # Require a specific version of stack, using version ranges # require-stack-version: -any # Default-# require-stack-version: >= 1.0.0-+# require-stack-version: ">=1.1"+# # Override the architecture used by stack, especially useful on Windows # arch: i386 # arch: x86_64-+# # Extra directories used by stack for building # extra-include-dirs: [/path/to/dir] # extra-lib-dirs: [/path/to/dir]-+# # Allow a newer minor version of GHC than the snapshot specifies # compiler-check: newer-minor