decimal-arithmetic 0.3.0.0 → 0.4.0.0

raw patch · 6 files changed

+354/−55 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• decimal-arithmetic.cabal +3/−3
• src/Numeric/Decimal.hs +2/−1
• src/Numeric/Decimal/Arithmetic.hs +5/−0
• src/Numeric/Decimal/Number.hs +56/−2
• src/Numeric/Decimal/Operation.hs +273/−48
• src/Numeric/Decimal/Operation.hs-boot +15/−1

@@ -1,9 +1,9 @@  name:                decimal-arithmetic-version:             0.3.0.0+version:             0.4.0.0 -synopsis:            An implementation of Mike Cowlishaw's-                     General Decimal Arithmetic Specification+synopsis:            An implementation of the General Decimal Arithmetic+                     Specification  description:         This package provides an implementation of the General                      Decimal Arithmetic Specification by Mike Cowlishaw.

@@ -122,5 +122,6 @@  Additional operations and control beyond what is provided by the basic numeric type classes are available through the use of "Numeric.Decimal.Arithmetic" and-"Numeric.Decimal.Operation".+"Numeric.Decimal.Operation". Advanced string conversion is also available+through "Numeric.Decimal.Conversion". -}

@@ -138,11 +138,16 @@   Arith e >>= f = Arith (e >>= g)     where g x = let Arith t = f x in t +-- | Traps (vis-à-vis 'TrapHandler') may call 'throwError' to abort the+-- arithmetic computation (or be caught using 'catchError'). instance MonadError (Exception p r) (Arith p r) where   throwError = Arith . throwError   catchError (Arith e) f = Arith (catchError e g)     where g x = let Arith t = f x in t +-- | The 'Context' of an arithmetic computation may be manipulated using 'get'+-- and 'put', et al. For example, the current signal flags can be observed+-- with @'gets' 'flags'@. instance MonadState (Context p r) (Arith p r) where   get = Arith   get   put = Arith . put

@@ -39,14 +39,15 @@ import Prelude hiding (exponent)  import Control.Monad (join)+import Data.Bits (Bits(..), FiniteBits(..)) import Data.Char (isSpace) import Data.Coerce (coerce) import Data.Ratio (numerator, denominator, (%)) import Numeric.Natural (Natural) import Text.ParserCombinators.ReadP (readP_to_S) -import {-# SOURCE #-} Numeric.Decimal.Conversion import {-# SOURCE #-} Numeric.Decimal.Arithmetic+import {-# SOURCE #-} Numeric.Decimal.Conversion import                Numeric.Decimal.Precision import                Numeric.Decimal.Rounding @@ -101,9 +102,14 @@          , payload     :: Payload          } +-- | The 'Show' instance uses the 'toScientificString' operation from+-- "Numeric.Decimal.Conversion". instance Show (Decimal p r) where   showsPrec d n = showParen (d > 0 && isNegative n) $ toScientificString n +-- | The 'Read' instance uses the 'toNumber' operation from+-- "Numeric.Decimal.Conversion" and rounds the result to the required+-- precision. instance (Precision p, Rounding r) => Read (Decimal p r) where   readsPrec _ str = [ (cast n, s)                     | (n, s) <- readParen False@@ -122,7 +128,7 @@     where decimalPrecision :: Decimal p r -> p           decimalPrecision = undefined -evalOp :: (Precision p, Rounding r) => Arith p r (Decimal p r) -> Decimal p r+evalOp :: Arith p r (Decimal p r) -> Decimal p r evalOp op = either exceptionResult id $ evalArith op newContext  type GeneralDecimal = Decimal PInfinite RoundHalfEven@@ -170,6 +176,10 @@ prop> min x y == y ==> y <= x -} +-- | Unlike the instances for 'Float' and 'Double', the lists returned by the+-- 'enumFromTo' and 'enumFromThenTo' methods in this instance terminate with+-- the last element strictly less than (greater than in the case of a negative+-- increment) or equal to the given bound. instance (Precision p, Rounding r) => Enum (Decimal p r) where   succ x = evalOp (x `Op.add`      one)   pred x = evalOp (x `Op.subtract` one)@@ -306,6 +316,8 @@ notyet :: String -> a notyet = error . (++ ": not yet implemented") +-- | The trigonometric and hyperbolic 'Floating' methods (other than the+-- precision-dependent constant 'pi') are not yet implemented. instance (FinitePrecision p, Rounding r) => Floating (Decimal p r) where   pi = castDown seriesPi @@ -399,6 +411,48 @@ prop> isNegativeZero (read "+0" :: BasicDecimal) == False prop> x /= 0 ==> isNegativeZero (x :: BasicDecimal) == False -}++-- | The 'Bits' instance makes use of the logical operations from the+-- /General Decimal Arithmetic Specification/ using a /digit-wise/+-- representation of bits where the /sign/ is non-negative, the /exponent/ is+-- 0, and each decimal digit of the /coefficient/ must be either 0 or 1.+instance FinitePrecision p => Bits (Decimal p r) where+  x  .&.  y = evalOp (x `Op.and` y)+  x  .|.  y = evalOp (x `Op.or`  y)+  x `xor` y = evalOp (x `Op.xor` y)++  complement = evalOp . Op.invert++  shift  x i = evalOp $ Op.shift  x (fromIntegral i :: GeneralDecimal)+  rotate x i = evalOp $ Op.rotate x (fromIntegral i :: GeneralDecimal)++  zeroBits = zero++  bit i | i >= 0 && i < finiteBitSize x = x+        | otherwise                     = zeroBits+    where x = coerce zero { coefficient = 10 ^ i }++  testBit x@Num { sign = Pos, coefficient = c, exponent = 0 } i+    | i >= 0 && i < finiteBitSize x = (c `quot` 10 ^ i) `rem` 10 == 1+  testBit _ _ = False++  bitSizeMaybe = precision+  bitSize      = finiteBitSize++  isSigned _ = False++  popCount Num { sign = Pos, coefficient = c, exponent = 0 } = popCount' c 0+    where popCount' :: Coefficient -> Int -> Int+          popCount' 0 c = c+          popCount' x c = case d of+            0 -> popCount' x'         c+            1 -> popCount' x' $! succ c+            _ -> 0+            where (x', d) = x `quotRem` 10+  popCount _ = 0++instance FinitePrecision p => FiniteBits (Decimal p r) where+  finiteBitSize x = let Just p = precision x in p  -- | A 'Decimal' representing the value zero zero :: Decimal p r

@@ -1,7 +1,6 @@ -{- | Eventually most or all of the arithmetic operations described in the-/General Decimal Arithmetic Specification/ will be provided here. For now, the-operations are mostly limited to those exposed through various class methods.+{- | The operations described in the /General Decimal Arithmetic Specification/+are provided here.  It is suggested to import this module qualified to avoid "Prelude" name clashes:@@ -10,7 +9,8 @@  Note that it is not usually necessary to import this module unless you want to use operations unavailable through class methods, or you need precise control-over the handling of exceptional conditions.+over the handling of exceptional conditions. (See also+"Numeric.Decimal.Arithmetic".) -} module Numeric.Decimal.Operation        ( -- * Arithmetic operations@@ -49,7 +49,7 @@          -- * Miscellaneous operations          -- $miscellaneous-operations -         -- and+       , and        , canonical        , class_, Class(..), Sign(..), NumberClass(..), NaNClass(..)          -- compareTotal@@ -58,7 +58,7 @@        , copyAbs        , copyNegate        , copySign-         -- invert+       , invert        , isCanonical        , isFinite        , isInfinite@@ -70,24 +70,27 @@        , isSubnormal        , isZero        , logb-         -- or+       , or        , radix-         -- rotate+       , rotate        , sameQuantum          -- scaleb        , shift-         -- xor+       , xor        ) where -import Prelude hiding (abs, compare, exp, exponent, isInfinite, isNaN, max, min,-                       subtract)+import Prelude hiding (abs, and, compare, exp, exponent, isInfinite, isNaN,+                       max, min, or, subtract) import qualified Prelude  import Control.Monad (join)+import Data.Bits (complement, setBit, testBit, zeroBits, (.&.), (.|.)) import Data.Coerce (coerce) import Data.List (find) import Data.Maybe (fromMaybe) +import qualified Data.Bits as Bits+ import Numeric.Decimal.Arithmetic import Numeric.Decimal.Number hiding (isFinite, isNormal, isSubnormal, isZero) import Numeric.Decimal.Precision@@ -318,7 +321,7 @@ -- 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 −Infinity, the result is 0 and exact. -- -- * If the operand is a zero, the result is 1 and exact. --@@ -439,7 +442,7 @@ -- 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 a zero, the result is −Infinity and exact. -- -- * If the operand is +Infinity, the result is +Infinity and exact. --@@ -535,7 +538,7 @@ -- 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 a zero, the result is −Infinity and exact. -- -- * If the operand is +Infinity, the result is +Infinity and exact. --@@ -732,7 +735,7 @@ -- either operand is a /special value/ then the general rules apply. No flags -- are set unless an operand is a signaling NaN. ----- Otherwise, the operands are compared, returning @-1@ if the first is less+-- Otherwise, the operands are compared, returning @−1@ if the first is less -- than the second, @0@ if they are equal, or @1@ if the first is greater than -- the second. compare :: (Precision p, Rounding r)@@ -1114,18 +1117,18 @@ -- 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+-- 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.+-- digits or fewer) then 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.@@ -1219,12 +1222,177 @@ -- including non-numeric comparisons, sign and other manipulations, and -- logical operations. --+-- The logical operations ('and', 'invert', 'or', and 'xor') take+-- /logical operands/, which are finite numbers with a /sign/ of 0, an+-- /exponent/ of 0, and a /coefficient/ whose digits must all be either 0 or+-- 1. The length of the result will be at most /precision/ digits (all of+-- which will be either 0 or 1); operands are truncated on the left or padded+-- with zeros on the left as necessary. The result of a logical operation is+-- never rounded and the only /flag/ that might be set is /invalid-operation/+-- (set if an operand is not a valid logical operand).+-- -- 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'. +data Logical = Logical { bits :: Integer, bitLength :: Int }++toLogical :: Decimal a b -> Maybe Logical+toLogical Num { sign = Pos, coefficient = c, exponent = 0 } =+  getBits c Logical { bits = zeroBits, bitLength = 0 }++  where getBits :: Coefficient -> Logical -> Maybe Logical+        getBits 0 g = return g+        getBits c g@Logical { bits = b, bitLength = l } = case d of+          0 -> getBits c' g {                    bitLength = succ l }+          1 -> getBits c' g { bits = setBit b l, bitLength = succ l }+          _ -> Nothing+          where (c', d) = c `quotRem` 10++toLogical _ = Nothing++fromLogical :: Logical -> Decimal a b+fromLogical Logical { bits = b, bitLength = l } =+  Num { sign = Pos, coefficient = fromBits 0 1 0, exponent = 0 }++  where fromBits :: Int -> Coefficient -> Coefficient -> Coefficient+        fromBits i r c+          | i == l      = c+          | testBit b i = fromBits i' r' (c + r)+          | otherwise   = fromBits i' r'  c+          where i' = succ i+                r' = r * 10++-- | 'and' is a logical operation which takes two logical operands. The result+-- is the digit-wise /and/ of the two operands; each digit of the result is+-- the logical and of the corresponding digits of the operands, aligned at the+-- least-significant digit. A result digit is 1 if both of the corresponding+-- operand digits are 1; otherwise it is 0.+and :: Precision p => Decimal a b -> Decimal c d -> Arith p r (Decimal p r)+and x y = case (toLogical x, toLogical y) of+  (Just lx, Just ly) -> getPrecision >>= \p ->+    let m = Prelude.min (bitLength lx) (bitLength ly)+        z = Logical { bits = bits lx .&. bits ly+                    , bitLength = maybe m (Prelude.min m) p }+    in return (fromLogical z)+  _ -> invalidOperation qNaN++{- $doctest-and+>>> op2 Op.and "0" "0"+0++>>> op2 Op.and "0" "1"+0++>>> op2 Op.and "1" "0"+0++>>> op2 Op.and "1" "1"+1++>>> op2 Op.and "1100" "1010"+1000++>>> op2 Op.and "1111" "10"+10+-}++-- | 'or' is a logical operation which takes two logical operands. The result+-- is the digit-wise /inclusive or/ of the two operands; each digit of the+-- result is the logical or of the corresponding digits of the operands,+-- aligned at the least-significant digit. A result digit is 1 if either or+-- both of the corresponding operand digits is 1; otherwise it is 0.+or :: Precision p => Decimal a b -> Decimal c d -> Arith p r (Decimal p r)+or x y = case (toLogical x, toLogical y) of+  (Just lx, Just ly) -> getPrecision >>= \p ->+    let m = Prelude.max (bitLength lx) (bitLength ly)+        z = Logical { bits = bits lx .|. bits ly+                    , bitLength = maybe m (Prelude.min m) p }+    in return (fromLogical z)+  _ -> invalidOperation qNaN++{- $doctest-or+>>> op2 Op.or "0" "0"+0++>>> op2 Op.or "0" "1"+1++>>> op2 Op.or "1" "0"+1++>>> op2 Op.or "1" "1"+1++>>> op2 Op.or "1100" "1010"+1110++>>> op2 Op.or "1110" "10"+1110+-}++-- | 'xor' is a logical operation which takes two logical operands. The result+-- is the digit-wise /exclusive or/ of the two operands; each digit of the+-- result is the logical exclusive-or of the corresponding digits of the+-- operands, aligned at the least-significant digit. A result digit is 1 if+-- one of the corresponding operand digits is 1 and the other is 0; otherwise+-- it is 0.+xor :: Precision p => Decimal a b -> Decimal c d -> Arith p r (Decimal p r)+xor x y = case (toLogical x, toLogical y) of+  (Just lx, Just ly) -> getPrecision >>= \p ->+    let m = Prelude.max (bitLength lx) (bitLength ly)+        z = Logical { bits = bits lx `Bits.xor` bits ly+                    , bitLength = maybe m (Prelude.min m) p }+    in return (fromLogical z)+  _ -> invalidOperation qNaN++{- $doctest-xor+>>> op2 Op.xor "0" "0"+0++>>> op2 Op.xor "0" "1"+1++>>> op2 Op.xor "1" "0"+1++>>> op2 Op.xor "1" "1"+0++>>> op2 Op.xor "1100" "1010"+110++>>> op2 Op.xor "1111" "10"+1101+-}++-- | 'invert' is a logical operation which takes one logical operand. The+-- result is the digit-wise /inversion/ of the operand; each digit of the+-- result is the inverse of the corresponding digit of the operand. A result+-- digit is 1 if the corresponding operand digit is 0; otherwise it is 0.+invert :: FinitePrecision p => Decimal a b -> Arith p r (Decimal p r)+invert x = case toLogical x of+  Just lx -> getPrecision >>= \(Just p) ->+    let z = Logical { bits = complement (bits lx), bitLength = p }+    in return (fromLogical z)+  _ -> invalidOperation qNaN++{- $doctest-invert+>>> op1 Op.invert "0"+111111111++>>> op1 Op.invert "1"+111111110++>>> op1 Op.invert "111111111"+0++>>> op1 Op.invert "101010101"+10101010+-}+ -- | 'canonical' takes one operand. The result has the same value as the -- operand but always uses a /canonical/ encoding. The definition of -- /canonical/ is implementation-defined; if more than one internal encoding@@ -1234,7 +1402,7 @@ -- -- If all possible operands have just one internal encoding each, then -- 'canonical' always returns the operand unchanged (that is, it has the same--- effect as 'copy'). This operation is unaffected by context and is quiet –+-- effect as 'copy'). This operation is unaffected by context and is quiet — -- no /flags/ are changed in the context. canonical :: Decimal a b -> Arith p r (Decimal a b) canonical = return@@ -1341,7 +1509,7 @@ -}  -- | 'copy' takes one operand. The result is a copy of the operand. This--- operation is unaffected by context and is quiet – no /flags/ are changed in+-- operation is unaffected by context and is quiet — no /flags/ are changed in -- the context. copy :: Decimal a b -> Arith p r (Decimal a b) copy = return@@ -1356,7 +1524,7 @@  -- | 'copyAbs' takes one operand. The result is a copy of the operand with the -- /sign/ set to 0. Unlike the 'abs' operation, this operation is unaffected--- by context and is quiet – no /flags/ are changed in the context.+-- by context and is quiet — no /flags/ are changed in the context. copyAbs :: Decimal a b -> Arith p r (Decimal a b) copyAbs n = return n { sign = Pos } @@ -1370,7 +1538,7 @@  -- | 'copyNegate' takes one operand. The result is a copy of the operand with -- the /sign/ inverted (a /sign/ of 0 becomes 1 and vice versa). Unlike the--- 'minus' operation, this operation is unaffected by context and is quiet –+-- 'minus' operation, this operation is unaffected by context and is quiet — -- no /flags/ are changed in the context. copyNegate :: Decimal a b -> Arith p r (Decimal a b) copyNegate n = return n { sign = negateSign (sign n) }@@ -1385,7 +1553,7 @@  -- | 'copySign' takes two operands. The result is a copy of the first operand -- with the /sign/ set to be the same as the /sign/ of the second--- operand. This operation is unaffected by context and is quiet – no /flags/+-- operand. This operation is unaffected by context and is quiet — no /flags/ -- are changed in the context. copySign :: Decimal a b -> Decimal c d -> Arith p r (Decimal a b) copySign n m = return n { sign = sign m }@@ -1413,7 +1581,7 @@ -- -- 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.+-- is quiet — no /flags/ are changed in the context. isCanonical :: Decimal a b -> Arith p r Bool isCanonical _ = return True @@ -1425,7 +1593,7 @@ -- | 'isFinite' takes one operand. The result is 1 if the operand is neither -- 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.+-- quiet — no /flags/ are changed in the context. isFinite :: Decimal a b -> Arith p r Bool isFinite = return . Number.isFinite @@ -1448,7 +1616,7 @@  -- | '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.+-- quiet — no /flags/ are changed in the context. isInfinite :: Decimal a b -> Arith p r Bool isInfinite n = return $ case n of   Inf{} -> True@@ -1467,7 +1635,7 @@  -- | '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.+-- and is quiet — no /flags/ are changed in the context. isNaN :: Decimal a b -> Arith p r Bool isNaN n = return $ case n of   QNaN{} -> True@@ -1510,7 +1678,7 @@  -- | '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.+-- quiet — no /flags/ are changed in the context. isQNaN :: Decimal a b -> Arith p r Bool isQNaN n = return $ case n of   QNaN{} -> True@@ -1529,7 +1697,7 @@  -- | '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.+-- and is quiet — no /flags/ are changed in the context. isSigned :: Decimal a b -> Arith p r Bool isSigned = return . Number.isNegative @@ -1546,7 +1714,7 @@  -- | '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.+-- quiet — no /flags/ are changed in the context. isSNaN :: Decimal a b -> Arith p r Bool isSNaN n = return $ case n of   SNaN{} -> True@@ -1587,7 +1755,7 @@ -}  -- | '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 –+-- 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 Bool isZero = return . Number.isZero@@ -1605,7 +1773,7 @@  -- | '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+-- 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@@ -1690,7 +1858,7 @@ -}  -- | 'shift' takes two operands. The second operand must be an integer (with--- an /exponent/ of 0) in the range /-precision/ through /precision/. If the+-- 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. --@@ -1706,20 +1874,22 @@ -- -- 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 :: Precision p => Decimal a b -> Decimal c d -> Arith p r (Decimal p r) 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 z s = return z+  where z = case precision z of+          Just p  -> y { coefficient = coefficient y `rem` 10 ^ p }+          Nothing -> y+        y = case d of+          Pos -> n { coefficient =  c  *     10 ^ sc }+          Neg -> n { coefficient =  c `quot` 10 ^ sc }+shift n@Inf{}  s | validShift z s = return z where z = coerce n+shift n@QNaN{} s | validShift z s = return z where z = coerce n+shift n        _                  = 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 :: Precision p => p -> Decimal a b -> Bool+validShift px Num { coefficient = c, exponent = 0 } =+  let p = fromIntegral <$> precision px in maybe True (c <=) p validShift _ _ = False  {- $doctest-shift@@ -1737,4 +1907,59 @@  >>> op2 Op.shift "123456789" "+2" 345678900+-}++-- | 'rotate' 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 rotated+-- copy of the digits in the coefficient of the first operand. The number of+-- places of rotation is taken from the absolute value of the second operand,+-- with the rotation being to the left if the second operand is positive or to+-- the right otherwise.+--+-- If the coefficient of the first operand has fewer than /precision/ digits,+-- it is treated as though it were padded on the left with zeros to length+-- /precision/ before the rotation. Similarly, if the coefficient of the first+-- operand has more than /precision/ digits, it is truncated on the left+-- before use.+--+-- 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 'shift' operation can be used to shift rather than rotate a+-- coefficient.+rotate :: FinitePrecision p+       => Decimal a b -> Decimal c d -> Arith p r (Decimal p r)+rotate n@Num { coefficient = c } s@Num { sign = d, coefficient = sc }+  | validShift z s = return z+  where z = n { coefficient = rc * b + (lc `rem` b) }+        (lc, rc) = c `quotRem` b'+        (b , b') = case d of+          Pos -> (10^sc , 10^sc')+          Neg -> (10^sc', 10^sc )+        Just p = precision z+        sc'    = p - fromIntegral sc+rotate n@Inf{}  s | validShift z s = return z where z = coerce n+rotate n@QNaN{} s | validShift z s = return z where z = coerce n+rotate n        _                  = invalidOperation n++{- $doctest-rotate+>>> op2 Op.rotate "34" "8"+400000003++>>> op2 Op.rotate "12" "9"+12++>>> op2 Op.rotate "123456789" "-2"+891234567++>>> op2 Op.rotate "123456789" "0"+123456789++>>> op2 Op.rotate "123456789" "+2"+345678912 -}

@@ -15,9 +15,15 @@        , max        , power        , squareRoot+       , and+       , or+       , xor+       , invert+       , shift+       , rotate        ) where -import Prelude hiding (abs, compare, exp, max, min, subtract)+import Prelude hiding (abs, and, compare, exp, max, min, or, subtract)  import {-# SOURCE #-} Numeric.Decimal.Arithmetic import {-# SOURCE #-} Numeric.Decimal.Number@@ -52,3 +58,11 @@          => Decimal a b -> Decimal c d -> Arith p r (Decimal p r) squareRoot :: FinitePrecision p            => Decimal a b -> Arith p r (Decimal p RoundHalfEven)++and    :: Precision p => Decimal a b -> Decimal c d -> Arith p r (Decimal p r)+or     :: Precision p => Decimal a b -> Decimal c d -> Arith p r (Decimal p r)+xor    :: Precision p => Decimal a b -> Decimal c d -> Arith p r (Decimal p r)+invert :: FinitePrecision p => Decimal a b -> Arith p r (Decimal p r)+shift  :: Precision p => Decimal a b -> Decimal c d -> Arith p r (Decimal p r)+rotate :: FinitePrecision p+       => Decimal a b -> Decimal c d -> Arith p r (Decimal p r)