packages feed

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 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