packages feed

decimal-arithmetic (empty) → 0.1.0.0

raw patch · 17 files changed

+1477/−0 lines, 17 filesdep +QuickCheckdep +basedep +decimal-arithmeticsetup-changed

Dependencies added: QuickCheck, base, decimal-arithmetic

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2016, Robert Leslie++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Robert Leslie nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,14 @@++General Decimal Arithmetic+==========================++This is a decimal arithmetic package for Haskell, suitable for+arbitrary-precision decimal floating point and integer calculations.++For details and the specification on which the implementation is based, see+Mike Cowlishaw's [General Decimal Arithmetic][].++  [General Decimal Arithmetic]: http://speleotrove.com/decimal/++While usable, the implementation is currently in its infancy. Additional+operations as well as an API for manipulating context flags are planned.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ TODO view
@@ -0,0 +1,7 @@+-*- Outline -*-++* To Do+** Test suite+** instance Floating (Number p r)+** instance RealFloat (Number p r)+** instance PrintfArg (Number p r)
+ decimal-arithmetic.cabal view
@@ -0,0 +1,60 @@++name:                decimal-arithmetic+version:             0.1.0.0++synopsis:            An implementation of Mike Cowlishaw's+                     General Decimal Arithmetic Specification++description:         This package provides an implementation of the General+                     Decimal Arithmetic Specification by Mike Cowlishaw.+                     .+                     For details, see: http://speleotrove.com/decimal/++homepage:            https://github.com/verement/decimal-arithmetic#readme+bug-reports:         https://github.com/verement/decimal-arithmetic/issues++license:             BSD3+license-file:        LICENSE++copyright:           © 2016 Robert Leslie+author:              Rob Leslie <rob@mars.org>+maintainer:          Rob Leslie <rob@mars.org>++stability:           alpha+category:            Numeric++build-type:          Simple+cabal-version:       >=1.10++extra-source-files:  README.md+                     TODO+                     stack.yaml++source-repository head+  type:                git+  location:            https://github.com/verement/decimal-arithmetic.git++library+  hs-source-dirs:      src++  exposed-modules:     Numeric.Decimal+                       Numeric.Decimal.Conversion+                       Numeric.Decimal.Operation+  other-modules:       Numeric.Decimal.Number+                       Numeric.Decimal.Precision+                       Numeric.Decimal.Rounding++  build-depends:       base >= 4.7 && < 5+  default-language:    Haskell2010+  default-extensions:  Trustworthy+  other-extensions:    RoleAnnotations++test-suite decimal-arithmetic-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base+                     , decimal-arithmetic+                     , QuickCheck+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010
+ src/Numeric/Decimal.hs view
@@ -0,0 +1,102 @@+{-|+Module      : Numeric.Decimal+Description : General arbitrary-precision decimal floating-point number type+Copyright   : © 2016 Robert Leslie+License     : BSD3+Maintainer  : rob@mars.org+Stability   : experimental++This module provides a general-purpose 'Number' type supporting decimal+arithmetic for both limited precision floating-point (IEEE 754-2008) and for+arbitrary precision floating-point (following the same principles as IEEE 754+and IEEE 854-1987) as described in the+<http://speleotrove.com/decimal/ General Decimal Arithmetic Specification>+by Mike Cowlishaw. In addition to floating-point arithmetic, integer and+unrounded floating-point arithmetic are included as subsets.++Unlike the binary floating-point types 'Float' and 'Double', the 'Number' type+can represent and perform arithmetic with decimal numbers exactly.+Internally, a 'Number' is represented with an integral coefficient and base-10+exponent.++The 'Number' type supports lossless conversion to and from a string+representation via the 'Show' and 'Read' instances. Note that there may be+multiple representations of values that are numerically equal (e.g. 1 and+1.00) which are preserved by this conversion.+-}+module Numeric.Decimal+       ( -- * Usage+         -- $usage++         -- * Arbitrary-precision decimal numbers+         Number+       , BasicDecimal+       , ExtendedDecimal+       , GeneralDecimal++         -- ** Precision types+       , module Numeric.Decimal.Precision++         -- ** Rounding types+       , Rounding++       , RoundHalfUp+       , RoundHalfEven+       , RoundHalfDown+       , RoundCeiling+       , RoundFloor+       , RoundUp+       , Round05Up+       , RoundDown++         -- * Functions+       , cast+       ) where++import Numeric.Decimal.Number+import Numeric.Decimal.Precision+import Numeric.Decimal.Rounding++-- | A basic decimal floating point number with 9 digits of precision, rounding half up+type BasicDecimal = Number P9 RoundHalfUp++-- | A decimal floating point number with selectable precision, rounding half even+type ExtendedDecimal p = Number p  RoundHalfEven++-- | A decimal floating point number with infinite precision+type GeneralDecimal = ExtendedDecimal PInfinite++basicDefaultContext :: TrapHandler P9 RoundHalfUp -> Context P9 RoundHalfUp+basicDefaultContext handler = defaultContext { trapHandler = trap }+  where trap Inexact   = id+        trap Rounded   = id+        trap Subnormal = id+        trap sig       = handler sig++extendedDefaultContext :: Context p RoundHalfEven+extendedDefaultContext = defaultContext++-- $usage+--+-- It is recommended that you create an alias for the type of numbers you wish+-- to support in your application. For example:+--+-- >  type Decimal = BasicDecimal+--+-- This is a basic number type with 9 decimal digits of precision that rounds+-- half up.+--+-- >  type Decimal = ExtendedDecimal P19+--+-- This is a number type with 19 decimal digits of precision that rounds half+-- even.+--+-- >  type Decimal = GeneralDecimal+--+-- This is a number type with infinite precision. (Note that not all+-- operations support numbers with infinite precision.)+--+-- It is also possible to use a decimal number type in a @default@+-- declaration, possibly replacing 'Double' or 'Integer'. For example:+--+-- >  default (Integer, Decimal)
+ src/Numeric/Decimal/Conversion.hs view
@@ -0,0 +1,257 @@++-- | The functions in this module implement conversions between 'Number' and+-- 'String' as described in the /General Decimal Arithmetic Specification/.+--+-- Because these functions are also used to implement 'Show' and 'Read' class+-- methods, it is not usually necessary to import this module except to use+-- the 'toEngineeringString' function.++module Numeric.Decimal.Conversion+       ( -- * Numeric string syntax+         -- $numeric-string-syntax++         -- * Conversion to numeric string+         toScientificString+       , toEngineeringString++         -- * Conversion from numeric string+       , toNumber+       ) where++import Prelude hiding (exponent, round)++import Control.Applicative ((<|>))+import Data.Char (isDigit, digitToInt, toLower, toUpper)+import Data.List (foldl')+import Text.ParserCombinators.ReadP (ReadP, char, many, many1, option, optional,+                                     satisfy)++import Numeric.Decimal.Number+import Numeric.Decimal.Precision+import Numeric.Decimal.Rounding++-- | Convert a number to a string, using scientific notation if an exponent is+-- needed.+toScientificString :: Number p r -> ShowS+toScientificString = showNumber exponential++  where exponential :: Exponent -> String -> Exponent -> ShowS+        exponential e (d1:ds@(_:_)) _ = showChar d1 . showChar '.' .+                                        showString ds . showExponent e+        exponential e     ds        _ = showString ds . showExponent e++-- | Convert a number to a string, using engineering notation if an exponent+-- is needed.+toEngineeringString :: Number p r -> ShowS+toEngineeringString = showNumber exponential++  where exponential :: Exponent -> String -> Exponent -> ShowS+        exponential e ds@"0" _ = showString ds' . showExponent (e + adj)+          where adj = (3 - e `mod` 3) `mod` 3+                ds' | adj > 0   = '0' : '.' : replicate (fromIntegral adj) '0'+                    | otherwise = ds+        exponential e ds cl = shift adj (e - adj) ds'+          where adj = e `mod` 3+                ds' | cl - 1 < adj = ds +++                      replicate (fromIntegral (adj - cl + 1)) '0'+                    | otherwise    = ds++        shift :: Exponent -> Exponent -> String -> ShowS+        shift 2 e (d1:d2:d3:ds@(_:_)) = showChar d1 . showChar d2 .+                                        showChar d3 . showChar '.' .+                                        showString ds . showExponent e++        shift 1 e (d1:d2:ds@(_:_))    = showChar d1 . showChar d2 .+                                        showChar '.' .+                                        showString ds . showExponent e++        shift 0 e (d1:ds@(_:_))       = showChar d1 . showChar '.' .+                                        showString ds . showExponent e++        shift _ e     ds              = showString ds . showExponent e++showNumber :: (Exponent -> String -> Exponent -> ShowS)+           -> Number p r -> ShowS+showNumber exponential num = signStr . case num of+  Num { coefficient = c, exponent = e }+    | e <= 0 && ae >= -6 -> nonExponential+    | otherwise          -> exponential ae cs cl++    where cs  = show c                   :: String+          cl  = fromIntegral (length cs) :: Exponent+          ae  = e + cl - 1               :: Exponent++          nonExponential :: ShowS+          nonExponential+            | e == 0    = showString cs+            | -e < cl   = let (ca, cb) = splitAt (fromIntegral $ cl + e) cs+                          in showString ca . showChar '.' . showString cb+            | otherwise = showChar '0' . showChar '.' .+              showString (replicate (fromIntegral $ -e - cl) '0') .+              showString cs++  Inf  {             } -> showString "Infinity"+  QNaN { payload = p } -> showString  "NaN" . diag p+  SNaN { payload = p } -> showString "sNaN" . diag p++  where signStr :: ShowS+        signStr = showString $ case sign num of+          Pos -> ""+          Neg -> "-"++        diag :: Payload -> ShowS+        diag 0 = showString ""+        diag d = shows d++showExponent :: Exponent -> ShowS+showExponent e+  | e == 0    = id  -- do not show zero exponent+  | e <  0    = indicator .                exps+  | otherwise = indicator . showChar '+' . exps+  where indicator = showChar 'E' :: ShowS+        exps      = shows e      :: ShowS++-- | Convert a string to a number, as defined by its abstract representation.+-- The string is expected to conform to the numeric string syntax described+-- here.+toNumber :: (Precision p, Rounding r) => ReadP (Number p r)+toNumber = round <$> (parseSign flipSign <*> parseNumericString)++  where parseSign :: (a -> a) -> ReadP (a -> a)+        parseSign negate = char '-' *> pure negate+          <|> optional (char '+') *> pure id++        parseNumericString :: ReadP (Number p r)+        parseNumericString = parseNumericValue <|> parseNaN++        parseNumericValue :: ReadP (Number p r)+        parseNumericValue = parseDecimalPart <*> option 0 parseExponentPart+          <|> parseInfinity++        parseDecimalPart :: ReadP (Exponent -> Number p r)+        parseDecimalPart = digitsWithPoint <|> digitsWithOptionalPoint++          where digitsWithPoint = do+                  digits <- many1 parseDigit+                  char '.'+                  fracDigits <- many parseDigit+                  return $ \e ->+                    Num { context = defaultContext+                        , sign = Pos+                        , coefficient = readDigits (digits ++ fracDigits)+                        , exponent = e - fromIntegral (length fracDigits)+                        }++                digitsWithOptionalPoint = fractionalDigits <|> wholeDigits++                fractionalDigits = do+                  char '.'+                  fracDigits <- many1 parseDigit+                  return $ \e ->+                    Num { context = defaultContext+                        , sign = Pos+                        , coefficient = readDigits fracDigits+                        , exponent = e - fromIntegral (length fracDigits)+                        }++                wholeDigits = do+                  digits <- many1 parseDigit+                  return $ \e -> Num { context = defaultContext+                                     , sign = Pos+                                     , coefficient = readDigits digits+                                     , exponent = e+                                     }++        parseExponentPart :: ReadP Exponent+        parseExponentPart = do+          parseString "E"+          parseSign negate <*> (readDigits <$> many1 parseDigit)++        parseInfinity :: ReadP (Number p r)+        parseInfinity = do+          parseString "Inf"+          optional $ parseString "inity"+          return Inf { context = defaultContext, sign = Pos }++        parseNaN :: ReadP (Number p r)+        parseNaN = parseQNaN <|> parseSNaN++        parseQNaN :: ReadP (Number p r)+        parseQNaN = do+          p <- parseNaNPayload+          return QNaN { context = defaultContext, sign = Pos, payload = p }++        parseSNaN :: ReadP (Number p r)+        parseSNaN = do+          parseString "s"+          p <- parseNaNPayload+          return SNaN { context = defaultContext, sign = Pos, payload = p }++        parseNaNPayload :: ReadP Payload+        parseNaNPayload = do+          parseString "NaN"+          readDigits <$> many parseDigit++        parseDigit :: ReadP Int+        parseDigit = digitToInt <$> satisfy isDigit++        parseString :: String -> ReadP ()+        parseString = mapM_ $ \c -> char (toLower c) <|> char (toUpper c)++        readDigits :: Num c => [Int] -> c+        readDigits = foldl' (\a b -> a * 10 + fromIntegral b) 0++-- $numeric-string-syntax+--+-- (The following description is from the+-- /General Decimal Arithmetic Specification/.)+--+-- Strings which are acceptable for conversion to the abstract representation+-- of numbers, or which might result from conversion from the abstract+-- representation to a string, are called /numeric strings/.+--+-- A /numeric string/ is a character string that describes either a /finite number/ or a /special value/.+--+-- *   If it describes a /finite number/, it includes one or more decimal+--     digits, with an optional decimal point. The decimal point may be embedded+--     in the digits, or may be prefixed or suffixed to them. The group of+--     digits (and optional point) thus constructed may have an optional sign+--     (“@+@” or “@-@”) which must come before any digits or decimal point.+--+--     The string thus described may optionally be followed by an “@E@”+--     (indicating an exponential part), an optional sign, and an integer+--     following the sign that represents a power of ten that is to be+--     applied. The “@E@” may be in uppercase or lowercase.+--+-- *   If it describes a /special value/, it is one of the case-independent+--     names “@Infinity@”, “@Inf@”, “@NaN@”, or “@sNaN@” (where the first two+--     represent /infinity/ and the second two represent /quiet NaN/ and+--     /signaling NaN/ respectively). The name may be preceded by an optional+--     sign, as for finite numbers. If a NaN, the name may also be followed by+--     one or more digits, which encode any diagnostic information.+--+-- No blanks or other white space characters are permitted in a numeric string.+--+-- == Examples+--+-- Some numeric strings are:+--+-- >     "0"          -- zero+-- >     "12"         -- a whole number+-- >    "-76"         -- a signed whole number+-- >     "12.70"      -- some decimal places+-- >     "+0.003"     -- a plus sign is allowed, too+-- >    "017."        -- the same as 17+-- >       ".5"       -- the same as 0.5+-- >     "4E+9"       -- exponential notation+-- >      "0.73e-7"   -- exponential notation, negative power+-- >     "Inf"        -- the same as Infinity+-- >     "-infinity"  -- the same as -Inf+-- >     "NaN"        -- not-a-Number+-- >     "NaN8275"    -- diagnostic NaN+--+-- == Notes+--+-- 1. A single period alone or with a sign is not a valid numeric string.+-- 2. A sign alone is not a valid numeric string.+-- 3. Significant (after the decimal point) and insignificant leading zeros are permitted.
+ src/Numeric/Decimal/Conversion.hs-boot view
@@ -0,0 +1,15 @@+-- -*- Haskell -*-++module Numeric.Decimal.Conversion+       ( toScientificString+       , toNumber+       ) where++import Text.ParserCombinators.ReadP (ReadP)++import {-# SOURCE #-} Numeric.Decimal.Number+import                Numeric.Decimal.Precision (Precision)+import {-# SOURCE #-} Numeric.Decimal.Rounding (Rounding)++toScientificString :: Number p r -> ShowS+toNumber :: (Precision p, Rounding r) => ReadP (Number p r)
+ src/Numeric/Decimal/Number.hs view
@@ -0,0 +1,401 @@++module Numeric.Decimal.Number+       ( Sign(..)+       , negateSign+       , xorSigns++       , Coefficient+       , numDigits++       , Exponent+       , Payload++       , Number(..)+       , zero+       , one+       , negativeOne+       , infinity+       , qNaN+       , sNaN++       , flipSign+       , cast+       , excessDigits++       , isPositive+       , isNegative+       , isFinite+       , isZero+       , isNormal+       , isSubnormal++       , Context(..)+       , TrapHandler+       , defaultContext+       , mergeContexts++       , Signal(..)+       , raiseSignal+       ) where++import Prelude hiding (exponent, round)++import Data.Bits (bit, complement, testBit, (.&.), (.|.))+import Data.Coerce (coerce)+import Data.Monoid ((<>))+import Data.Ratio (numerator, denominator, (%))+import Numeric.Natural (Natural)+import Text.ParserCombinators.ReadP (readP_to_S)++import {-# SOURCE #-} Numeric.Decimal.Conversion+import                Numeric.Decimal.Precision+import {-# SOURCE #-} Numeric.Decimal.Rounding++import {-# SOURCE #-} qualified Numeric.Decimal.Operation as Op++import qualified GHC.Real++data Sign = Pos | Neg+          deriving (Eq, Enum, Show)++negateSign :: Sign -> Sign+negateSign Pos = Neg+negateSign Neg = Pos++xorSigns :: Sign -> Sign -> Sign+xorSigns Pos Pos = Pos+xorSigns Pos Neg = Neg+xorSigns Neg Pos = Neg+xorSigns Neg Neg = Pos++signFactor :: Num a => Sign -> a+signFactor Pos =  1+signFactor Neg = -1++signFunc :: Num a => Sign -> a -> a+signFunc Pos = id+signFunc Neg = negate++type Coefficient = Natural+type Exponent = Integer++type Payload = Coefficient++-- | A decimal floating point number with selectable precision and rounding+-- algorithm+data Number p r+  = Num  { context     :: Context p r+         , sign        :: Sign+         , coefficient :: Coefficient+         , exponent    :: Exponent+         }+  | Inf  { context     :: Context p r+         , sign        :: Sign+         }+  | QNaN { context     :: Context p r+         , sign        :: Sign+         , payload     :: Payload+         }+  | SNaN { context     :: Context p r+         , sign        :: Sign+         , payload     :: Payload+         }++instance Precision p => Precision (Number p r) where+  precision = precision . numberPrecision+    where numberPrecision :: Number p r -> p+          numberPrecision = undefined++instance Show (Number p r) where+  showsPrec d n = showParen (d > 0 && isNegative n) $ toScientificString n++instance (Precision p, Rounding r) => Read (Number p r) where+  readsPrec _ = readP_to_S toNumber++instance (Precision p, Rounding r) => Eq (Number p r) where+  x == y = case x `Op.compare` y of+    Num { coefficient = 0 } -> True+    _                       -> False++instance (Precision p, Rounding r) => Ord (Number p r) where+  x `compare` y = case x `Op.compare` y of+    Num { coefficient = 0 } -> EQ+    Num { sign = Neg      } -> LT+    Num { sign = Pos      } -> GT+    _                       -> GT  -- match Prelude behavior for NaN++  x < y = case x `Op.compare` y of+    Num { sign = Neg      } -> True+    _                       -> False++  x <= y = case x `Op.compare` y of+    Num { sign = Neg      } -> True+    Num { coefficient = 0 } -> True+    _                       -> False++  x > y = case x `Op.compare` y of+    Num { coefficient = 0 } -> False+    Num { sign = Pos      } -> True+    _                       -> False++  x >= y = case x `Op.compare` y of+    Num { sign = Pos      } -> True+    _                       -> False++  max nan@SNaN{} _ = nan+  max _ nan@SNaN{} = nan+  max nan@QNaN{} _ = nan+  max _ nan@QNaN{} = nan+  max x y+    | x >= y    = x+    | otherwise = y++  min nan@SNaN{} _ = nan+  min _ nan@SNaN{} = nan+  min nan@QNaN{} _ = nan+  min _ nan@QNaN{} = nan+  min x y+    | x < y     = x+    | otherwise = y++instance (FinitePrecision p, Rounding r) => Enum (Number p r) where+  toEnum = fromIntegral+  fromEnum = truncate++instance (Precision p, Rounding r) => Num (Number p r) where+  (+)    = Op.add+  (-)    = Op.subtract+  (*)    = Op.multiply+  negate = Op.minus+  abs    = Op.abs++  signum n = case n of+    Num { coefficient = 0 } -> zero+    Num { sign = s        } -> one { sign = s }+    Inf { sign = s        } -> one { sign = s }+    _                       -> n++  fromInteger x = Num { context     = defaultContext+                      , sign        = sx+                      , coefficient = fromInteger (abs x)+                      , exponent    = 0+                      }+    where sx = case signum x of+            -1 -> Neg+            _  -> Pos++instance (Precision p, Rounding r) => Real (Number p r) where+  toRational Num { sign = s, coefficient = c, exponent = e }+    | e >= 0    = fromInteger (signFactor s * fromIntegral c * 10^e)+    | otherwise = (signFactor s * fromIntegral c) % 10^(-e)+  toRational n = signFunc (sign n) $ case n of+    Inf{} -> GHC.Real.infinity+    _     -> GHC.Real.notANumber++instance (FinitePrecision p, Rounding r) => Fractional (Number p r) where+  (/) = Op.divide+  fromRational r = fromInteger (numerator r) / fromInteger (denominator r)++instance (FinitePrecision p, Rounding r) => RealFrac (Number p r) where+  properFraction x@Num { sign = s, coefficient = c, exponent = e }+    | e < 0     = (n, f)+    | otherwise = (signFactor s * fromIntegral c * 10^e, zero)+    where n = signFactor s * fromIntegral q+          f = x { coefficient = r, exponent = -(fromIntegral $ numDigits r) }+          (q, r) = c `quotRem` (10^(-e))+  properFraction nan = (0, nan)++-- | A 'Number' representing the value zero+zero :: Number p r+zero = Num { context     = defaultContext+           , sign        = Pos+           , coefficient = 0+           , exponent    = 0+           }++-- | A 'Number' representing the value one+one :: Number p r+one = zero { coefficient = 1 }++-- | A 'Number' representing the value negative one+negativeOne :: Number p r+negativeOne = one { sign = Neg }++-- | A 'Number' representing the value positive infinity+infinity :: Number p r+infinity = Inf { context = defaultContext, sign = Pos }++-- | A 'Number' representing undefined results+qNaN :: Number p r+qNaN = QNaN { context = defaultContext, sign = Pos, payload = 0 }++-- | A signaling 'Number' representing undefined results+sNaN :: Number p r+sNaN = SNaN { context = defaultContext, sign = Pos, payload = 0 }++-- | Negate the given 'Number' by directly flipping its sign.+flipSign :: Number p r -> Number p r+flipSign n = n { sign = negateSign (sign n) }++-- | Cast a 'Number' to another precision and/or rounding algorithm,+-- immediately rounding if necessary to the new precision using the new+-- algorithm.+cast :: (Precision p, Rounding r) => Number a b -> Number p r+cast = round . coerce++numDigits :: Coefficient -> Int+numDigits x+  | x <         10 = 1+  | x <        100 = 2+  | x <       1000 = 3+  | x <      10000 = 4+  | x <     100000 = 5+  | x <    1000000 = 6+  | x <   10000000 = 7+  | x <  100000000 = 8+  | x < 1000000000 = 9+  | otherwise      = 9 + numDigits (x `quot` 1000000000)++excessDigits :: Precision p => Number p r -> Maybe Int+excessDigits x@Num { coefficient = c } = precision x >>= excess+  where excess p+          | d > p     = Just (d - p)+          | otherwise = Nothing+          where d = numDigits c+excessDigits _ = Nothing++maxCoefficient :: Precision p => p -> Maybe Coefficient+maxCoefficient p = (\d -> 10 ^ d - 1) <$> precision p++-- | Is the sign of the given 'Number' positive?+isPositive :: Number p r -> Bool+isPositive n = case sign n of+  Pos -> True+  Neg -> False++-- | Is the sign of the given 'Number' negative?+isNegative :: Number p r -> Bool+isNegative n = case sign n of+  Neg -> True+  Pos -> False++-- | Does the given 'Number' represent a finite value?+isFinite :: Number p r -> Bool+isFinite Num{} = True+isFinite _     = False++-- | Does the given 'Number' represent the value zero?+isZero :: Number p r -> Bool+isZero Num { coefficient = 0 } = True+isZero _                       = False++-- | Is the given 'Number' normal?+isNormal :: Precision p => Number p r -> Bool+isNormal n+  | isFinite n && not (isZero n) &&+    maybe True (adjustedExponent n >=) (eMin n) = True+  | otherwise                                   = False++-- | Is the given 'Number' subnormal?+isSubnormal :: Precision p => Number p r -> Bool+isSubnormal n+  | isFinite n && not (isZero n) &&+    maybe False (adjustedExponent n <) (eMin n) = True+  | otherwise                                   = False++-- | Upper limit on the absolute value of the exponent+eLimit :: Precision p => Number p r -> Maybe Exponent+eLimit = eMax++-- | Minimum value of the adjusted exponent+eMin :: Precision p => Number p r -> Maybe Exponent+eMin n = (1 -) <$> eMax n++-- | Maximum value of the adjusted exponent+eMax :: Precision p => Number p r -> Maybe Exponent+eMax n = subtract 1 . (10 ^) . numDigits <$> base+  where mlength = precision n                    :: Maybe Int+        base = (10 *) . fromIntegral <$> mlength :: Maybe Natural++-- | Minimum value of the exponent for subnormal results+eTiny :: Precision p => Number p r -> Maybe Exponent+eTiny n = (-) <$> eMin n <*> (fromIntegral . subtract 1 <$> precision n)++-- | Range of permissible exponent values+eRange :: Precision p => Number p r -> Maybe (Exponent, Exponent)+eRange n@Num { coefficient = c } = range <$> eLimit n+  where range :: Exponent -> (Exponent, Exponent)+        range lim = (-lim - clm1 + 1, lim - clm1)+        clength = numDigits c             :: Int+        clm1 = fromIntegral (clength - 1) :: Exponent+eRange _ = Nothing++adjustedExponent :: Number p r -> Exponent+adjustedExponent Num { coefficient = c, exponent = e } =+  e + fromIntegral (clength - 1)+  where clength = numDigits c :: Int+adjustedExponent _ = error "adjustedExponent: not a finite number"++type TrapHandler p r = Signal -> Number p r -> Number p r++data Context p r = Context { signalFlags :: Signals+                           , trapHandler :: TrapHandler p r+                           }++instance Precision p => Precision (Context p r) where+  precision = precision . contextPrecision+    where contextPrecision :: Context p r -> p+          contextPrecision = undefined++defaultContext :: Context p r+defaultContext = Context mempty (const id)++setSignal :: Signal -> Context p r -> Context p r+setSignal sig cxt = cxt { signalFlags = signalFlags cxt <> signal sig }++modifyContext :: (Context p r -> Context p r) -> Number p r -> Number p r+modifyContext f n = n { context = f (context n) }++mergeContexts :: Context p r -> Context p r -> Context p r+mergeContexts cxt1 cxt2 =+  cxt1 { signalFlags = signalFlags cxt1 <> signalFlags cxt2 }++data Signal+  = Clamped+  | DivisionByZero+  | Inexact+  | InvalidOperation+  | Overflow+  | Rounded+  | Subnormal+  | Underflow+  deriving (Enum, Bounded, Show)++newtype Signals = Signals Int++instance Show Signals where+  showsPrec d sigs = showParen (d > 10) $+    showString "signals " . showsPrec 11 (signalList sigs)++instance Monoid Signals where+  mempty = Signals 0+  Signals x `mappend` Signals y = Signals (x .|. y)++signal :: Signal -> Signals+signal = Signals . bit . fromEnum++unsignal :: Signal -> Signals -> Signals+unsignal sig (Signals ss) = Signals $ ss .&. complement (bit $ fromEnum sig)++signals :: [Signal] -> Signals+signals = foldr (\s n -> signal s <> n) mempty++signalList :: Signals -> [Signal]+signalList sigs = filter (testSignal sigs) [minBound..maxBound]++testSignal :: Signals -> Signal -> Bool+testSignal (Signals ss) = testBit ss . fromEnum++raiseSignal :: Signal -> Number p r -> Number p r+raiseSignal sig n = let n' = modifyContext (setSignal sig) n+                    in trapHandler (context n') sig n'
+ src/Numeric/Decimal/Number.hs-boot view
@@ -0,0 +1,10 @@+-- -*- Haskell -*-++{-# LANGUAGE RoleAnnotations #-}++module Numeric.Decimal.Number+       ( Number+       ) where++type role Number phantom phantom+data Number p r
+ src/Numeric/Decimal/Operation.hs view
@@ -0,0 +1,202 @@++-- | 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.+--+-- It is not usually necessary to import this module.++module Numeric.Decimal.Operation+       ( abs+       , add+       , subtract+       , multiply+       , divide+       , plus+       , minus+       , compare+       ) where++import Prelude hiding (abs, compare, exponent, round, subtract)+import qualified Prelude++import                Numeric.Decimal.Number+import                Numeric.Decimal.Precision+import {-# SOURCE #-} Numeric.Decimal.Rounding++invalidOperation :: Number p r -> Number p r+invalidOperation n = raiseSignal InvalidOperation qNaN { context = context n }++toQNaN :: Number p r -> Number p r+toQNaN SNaN { context = t, sign = s, payload = p } =+  QNaN { context = t, sign = s, payload = p }+toQNaN n@QNaN{} = n+toQNaN n = qNaN { context = context n, sign = sign n }++toQNaN2 :: Number p r -> Number p r -> Number p r+toQNaN2 nan@SNaN{} _ = toQNaN nan+toQNaN2 _ nan@SNaN{} = toQNaN nan+toQNaN2 nan@QNaN{} _ = nan+toQNaN2 _ nan@QNaN{} = nan+toQNaN2 n _          = toQNaN n++-- | Add two operands.+add :: (Precision p, Rounding r) => Number p r -> Number p r -> Number p r+add Num { context = xt, sign = xs, coefficient = xc, exponent = xe }+    Num { context = yt, sign = ys, coefficient = yc, exponent = ye } = round rn++  where rn = Num { context = rt, sign = rs, coefficient = rc, exponent = re }+        rt = mergeContexts xt yt+        rs | rc /= 0                     = if xac > yac then xs else ys+           | xs == Neg && ys == Neg      = Neg+           | xs /= ys && isRoundFloor rn = Neg+           | otherwise                   = Pos+        rc | xs == ys  = xac + yac+           | xac > yac = xac - yac+           | otherwise = yac - xac+        re = min xe ye+        (xac, yac) | xe == ye  = (xc, yc)+                   | xe >  ye  = (xc * 10^n, yc)+                   | otherwise = (xc, yc * 10^n)+          where n = Prelude.abs (xe - ye)++add inf@Inf { context = xt, sign = xs } Inf { context = yt, sign = ys }+  | xs == ys  = inf { context = mergeContexts xt yt }+  | otherwise = invalidOperation inf { context = mergeContexts xt yt }+add inf@Inf{} Num{} = inf+add Num{} inf@Inf{} = inf+add x y             = toQNaN2 x y++-- | Subtract the second operand from the first.+subtract :: (Precision p, Rounding r) => Number p r -> Number p r -> Number p r+subtract x = add x . flipSign++-- | Unary minus (negation)+minus :: (Precision p, Rounding r) => Number p r -> Number p r+minus x = zero { exponent = exponent x } `subtract` x++-- | Unary plus+plus :: (Precision p, Rounding r) => Number p r -> Number p r+plus x = zero { exponent = exponent x } `add` x++-- | Multiply two operands.+multiply :: (Precision p, Rounding r) => Number p r -> Number p r -> Number p r+multiply Num { context = xt, sign = xs, coefficient = xc, exponent = xe }+         Num { context = yt, sign = ys, coefficient = yc, exponent = ye } =+  round rn++  where rn = Num { context = rt, sign = rs, coefficient = rc, exponent = re }+        rt = mergeContexts xt yt+        rs = xorSigns xs ys+        rc = xc * yc+        re = xe + ye++multiply Inf { context = xt, sign = xs } Inf { context = yt, sign = ys } =+  Inf { context = mergeContexts xt yt, sign = xorSigns xs ys }+multiply Inf { context = xt, sign = xs } Num { context = yt, sign = ys } =+  Inf { context = mergeContexts xt yt, sign = xorSigns xs ys }+multiply Num { context = xt, sign = xs } Inf { context = yt, sign = ys } =+  Inf { context = mergeContexts xt yt, sign = xorSigns xs ys }+multiply x y = toQNaN2 x y++-- | Divide the first dividend operand by the second divisor using long division.+divide :: (FinitePrecision p, Rounding r)+       => Number p r -> Number p r -> Number p r+divide dividend@Num{ sign = xs } Num { coefficient = 0, sign = ys }+  | isZero dividend = invalidOperation qNaN+  | otherwise       = raiseSignal DivisionByZero+                        infinity { sign = xorSigns xs ys }+divide Num { context = xt, sign = xs, coefficient = xc, exponent = xe }+       Num { context = yt, sign = ys, coefficient = yc, exponent = ye } =+  result++  where rn = Num { context = rt, sign = rs, coefficient = rc, exponent = re }+        rt = mergeContexts xt yt+        rs = xorSigns xs ys+        (rc, rem, dv, adjust) = longDivision xc yc p+        re = xe - (ye + adjust)+        Just p = precision rn+        result+          | rem == 0  = rn+          | otherwise = round $ 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 }++divide Inf{} Inf{} = invalidOperation qNaN+divide Inf { context = xt, sign = xs } Num { context = yt, sign = ys } =+  Inf { context = mergeContexts xt yt, sign = xorSigns xs ys }+divide Num { context = xt, sign = xs } Inf { context = yt, sign = ys } =+  zero { context = mergeContexts xt yt, sign = xorSigns xs ys }+divide x y = toQNaN2 x y++type Dividend  = Coefficient+type Divisor   = Coefficient+type Quotient  = Coefficient+type Remainder = Coefficient++longDivision :: Dividend -> Divisor -> Int+             -> (Quotient, Remainder, Divisor, Exponent)+longDivision 0  dv _ = (0, 0, dv, 0)+longDivision dd dv p = step1 dd dv 0++  where step1 dd dv adjust+          | dd <       dv = step1 (dd * 10)  dv       (adjust + 1)+          | dd >= 10 * dv = step1  dd       (dv * 10) (adjust - 1)+          | otherwise     = step2  dd        dv        adjust++        step2 = step3 0++        step3 r dd dv adjust+          | dv <= dd                 = step3 (r +  1) (dd - dv) dv  adjust+          | (dd == 0 && adjust >= 0) ||+            numDigits r == p         = step4  r        dd       dv  adjust+          | otherwise                = step3 (r * 10) (dd * 10) dv (adjust + 1)++        step4 = (,,,)++-- | 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.+abs :: (Precision p, Rounding r) => Number p r -> Number p r+abs x+  | isNegative x = minus x+  | otherwise    = plus  x++-- | Compare the values of two operands numerically, 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) => Number p r -> Number p r -> Number p r+compare x@Num{} y@Num{} = (nzp $ xn `subtract` yn) { context = rt }++  where (xn, yn) | sign x /= sign y = (nzp x, nzp y)+                 | otherwise        = (x, y)++        rt = mergeContexts (context x) (context y)++        nzp :: Number p r -> Number p r+        nzp Num { context = t, sign = s, coefficient = c }+          | c == 0    = zero        { context = t }+          | s == Pos  = one         { context = t }+          | otherwise = negativeOne { context = t }+        nzp Inf { context = t, sign = s }+          | s == Pos  = one         { context = t }+          | otherwise = negativeOne { context = t }+        nzp n = toQNaN n++compare Inf { context = xt, sign = xs } Inf { context = yt, sign = ys }+  | xs == ys  = zero        { context = rt }+  | xs == Neg = negativeOne { context = rt }+  | otherwise = one         { context = rt }+  where rt = mergeContexts xt yt+compare Inf { context = xt, sign = xs } Num { context = yt }+  | xs == Neg = negativeOne { context = rt }+  | otherwise = one         { context = rt }+  where rt = mergeContexts xt yt+compare Num { context = xt } Inf { context = yt, sign = ys }+  | ys == Pos = negativeOne { context = rt }+  | otherwise = one         { context = rt }+  where rt = mergeContexts xt yt+compare nan@SNaN{} _ = invalidOperation nan+compare _ nan@SNaN{} = invalidOperation nan+compare x y          = toQNaN2 x y
+ src/Numeric/Decimal/Operation.hs-boot view
@@ -0,0 +1,26 @@+-- -*- Haskell -*-++module Numeric.Decimal.Operation+       ( add+       , subtract+       , multiply+       , divide+       , minus+       , abs+       , compare+       ) where++import Prelude hiding (abs, compare, subtract)++import {-# SOURCE #-} Numeric.Decimal.Number+import                Numeric.Decimal.Precision+import {-# SOURCE #-} Numeric.Decimal.Rounding++add      :: (Precision p, Rounding r) => Number p r -> Number p r -> Number p r+subtract :: (Precision p, Rounding r) => Number p r -> Number p r -> Number p r+multiply :: (Precision p, Rounding r) => Number p r -> Number p r -> Number p r+divide   :: (FinitePrecision p, Rounding r) =>+                                         Number p r -> Number p r -> Number p r+minus    :: (Precision p, Rounding r) => Number p r -> Number p r+abs      :: (Precision p, Rounding r) => Number p r -> Number p r+compare  :: (Precision p, Rounding r) => Number p r -> Number p r -> Number p r
+ src/Numeric/Decimal/Precision.hs view
@@ -0,0 +1,100 @@++module Numeric.Decimal.Precision+       ( Precision(..)+       , FinitePrecision++       , P1 , P2 , P3 , P4 , P5 , P6 , P7 , P8 , P9 , P10+       , P11, P12, P13, P14, P15, P16, P17, P18, P19, P20+       , P21, P22, P23, P24, P25, P26, P27, P28, P29, P30+       , P31, P32, P33, P34, P35, P36, P37, P38, P39, P40+       , P41, P42, P43, P44, P45, P46, P47, P48, P49, P50++       , P75, P100, P150, P200, P250, P300, P400, P500, P1000, P2000++       , PPlus1, PTimes2++       , PInfinite+       ) where++-- | Precision indicates the maximum number of significant digits a number may+-- have.+class Precision p where+  -- | Return the precision of the argument, or 'Nothing' if the precision is infinite.+  precision :: p -> Maybe Int++-- | A subclass of precisions which are finite+class Precision p => FinitePrecision p++-- | A precision of unlimited significant digits+data PInfinite+instance Precision PInfinite where+  precision _ = Nothing++-- | A precision of 1 significant digit+data P1+instance Precision P1 where+  precision _ = Just 1+instance FinitePrecision P1++-- | 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)++-- | 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  = PTimes2 P1 ; type P3  = PPlus1 P2+-- ^ A precision of 3 significant digits++-- | Et cetera+type P4  = PTimes2 P2 ; type P5  = PPlus1 P4+type P6  = PTimes2 P3 ; type P7  = PPlus1 P6+type P8  = PTimes2 P4 ; type P9  = PPlus1 P8+type P10 = PTimes2 P5 ; type P11 = PPlus1 P10+type P12 = PTimes2 P6 ; type P13 = PPlus1 P12+type P14 = PTimes2 P7 ; type P15 = PPlus1 P14+type P16 = PTimes2 P8 ; type P17 = PPlus1 P16+type P18 = PTimes2 P9 ; type P19 = PPlus1 P18+type P20 = PTimes2 P10; type P21 = PPlus1 P20+type P22 = PTimes2 P11; type P23 = PPlus1 P22+type P24 = PTimes2 P12; type P25 = PPlus1 P24+type P26 = PTimes2 P13; type P27 = PPlus1 P26+type P28 = PTimes2 P14; type P29 = PPlus1 P28+type P30 = PTimes2 P15; type P31 = PPlus1 P30+type P32 = PTimes2 P16; type P33 = PPlus1 P32+type P34 = PTimes2 P17; type P35 = PPlus1 P34+type P36 = PTimes2 P18; type P37 = PPlus1 P36+type P38 = PTimes2 P19; type P39 = PPlus1 P38+type P40 = PTimes2 P20; type P41 = PPlus1 P40+type P42 = PTimes2 P21; type P43 = PPlus1 P42+type P44 = PTimes2 P22; type P45 = PPlus1 P44+type P46 = PTimes2 P23; type P47 = PPlus1 P46+type P48 = PTimes2 P24; type P49 = PPlus1 P48++type P50 = PTimes2 P25+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 = PTimes2 P125++type P300 = PTimes2 P150+type P400 = PTimes2 P200+type P500 = PTimes2 P250++type P1000 = PTimes2 P500+type P2000 = PTimes2 P1000
+ src/Numeric/Decimal/Rounding.hs view
@@ -0,0 +1,172 @@++module Numeric.Decimal.Rounding+       ( Rounding(..)++       , RoundDown+       , RoundHalfUp+       , RoundHalfEven+       , RoundCeiling+       , RoundFloor++       , RoundHalfDown+       , RoundUp+       , Round05Up+       ) where++import Prelude hiding (exponent)++import Numeric.Decimal.Number+import Numeric.Decimal.Precision++-- | A rounding algorithm to use when the result of an arithmetic operation+-- exceeds the precision of the result type+class Rounding r where+  round :: Precision p => Number p r -> Number p r++  isRoundFloor :: Number p r -> Bool+  isRoundFloor _ = False++-- Required...++-- | Round toward 0 (truncate)+data RoundDown+instance Rounding RoundDown where+  round = roundDown++-- | 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.+data RoundHalfUp+instance Rounding RoundHalfUp where+  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.+data RoundHalfEven+instance Rounding RoundHalfEven where+  round = roundHalfEven++-- | Round toward +∞+data RoundCeiling+instance Rounding RoundCeiling where+  round = roundCeiling++-- | Round toward −∞+data RoundFloor+instance Rounding RoundFloor where+  round = roundFloor+  isRoundFloor _ = True++-- Optional...++-- | 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.+data RoundHalfDown+instance Rounding RoundHalfDown where+  round = roundHalfDown++-- | Round away from 0+data RoundUp+instance Rounding RoundUp where+  round = roundUp++-- | Round zero or five away from 0+data Round05Up+instance Rounding Round05Up where+  round = round05Up++-- Implementations++rounded :: (Coefficient -> Coefficient -> Coefficient ->+            Number p r -> Number p r -> Number p r)+        -> Int -> Number p r -> Number p r+rounded f d n = raiseSignal Rounded rounded'+  where rounded'+          | r /= 0    = raiseSignal Inexact n'+          | otherwise = n'+        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 => Number p r -> Number p r+roundDown n = roundDown' (excessDigits n)+  where roundDown' Nothing  = n+        roundDown' (Just d) = rounded choice d n++        choice _h _q _r down _up = down++roundHalfUp :: Precision p => Number p r -> Number p r+roundHalfUp n = roundHalfUp' (excessDigits n)+  where roundHalfUp' Nothing  = n+        roundHalfUp' (Just d) = rounded choice d n++        choice h _q r down up+          | r >= h    = roundHalfUp up+          | otherwise = down++roundHalfEven :: Precision p => Number p r -> Number p r+roundHalfEven n = roundHalfEven' (excessDigits n)+  where roundHalfEven' Nothing  = n+        roundHalfEven' (Just d) = rounded choice d n++        choice h q r down up = case r `Prelude.compare` h of+          LT -> down+          GT -> roundHalfEven up+          EQ | even q    -> down+             | otherwise -> roundHalfEven up++roundCeiling :: Precision p => Number p r -> Number p r+roundCeiling n = roundCeiling' (excessDigits n)+  where roundCeiling' Nothing  = n+        roundCeiling' (Just d) = rounded choice d n++        choice _h _q r down up+          | r == 0 || sign n == Neg = down+          | otherwise               = roundCeiling up++roundFloor :: Precision p => Number p r -> Number p r+roundFloor n = roundFloor' (excessDigits n)+  where roundFloor' Nothing  = n+        roundFloor' (Just d) = rounded choice d n++        choice _h _q r down up+          | r == 0 || sign n == Pos = down+          | otherwise               = roundFloor up++roundHalfDown :: Precision p => Number p r -> Number p r+roundHalfDown n = roundHalfDown' (excessDigits n)+  where roundHalfDown' Nothing  = n+        roundHalfDown' (Just d) = rounded choice d n++        choice h _q r down up+          | r > h     = roundHalfDown up+          | otherwise = down++roundUp :: Precision p => Number p r -> Number p r+roundUp n = roundUp' (excessDigits n)+  where roundUp' Nothing  = n+        roundUp' (Just d) = rounded choice d n++        choice _h _q r down up+          | r == 0    = down+          | otherwise = roundUp up++round05Up :: Precision p => Number p r -> Number p r+round05Up n = round05Up' (excessDigits n)+  where round05Up' Nothing  = n+        round05Up' (Just d) = rounded choice d n++        choice _h q r down up+          | r == 0           = down+          | d == 0 || d == 5 = round05Up up  -- overflow -> roundDown?+          | otherwise        = down+          where d = q `rem` 10
+ src/Numeric/Decimal/Rounding.hs-boot view
@@ -0,0 +1,14 @@+-- -*- Haskell -*-++module Numeric.Decimal.Rounding+       ( Rounding(..)+       ) where++import {-# SOURCE #-} Numeric.Decimal.Number (Number)+import                Numeric.Decimal.Precision (Precision)++class Rounding r where+  round :: Precision p => Number p r -> Number p r++  isRoundFloor :: Number p r -> Bool+  isRoundFloor _ = False
+ stack.yaml view
@@ -0,0 +1,35 @@+# This file was automatically generated by stack init+# For more information, 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++# Local packages, usually specified by relative directory name+packages:+- '.'+# 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+flags: {}++# Extra package databases containing global packages+extra-package-dbs: []++# 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++# 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
+ test/Spec.hs view
@@ -0,0 +1,30 @@++import Numeric.Decimal+import Test.QuickCheck++main :: IO ()+main = putStrLn "Test suite not yet implemented"++infinity :: (Precision p, Rounding r) => Number p r+infinity = read "Infinity"++instance (Precision p, Rounding r) => Arbitrary (Number p r) where+  arbitrary = frequency [(85, genNum), (10, genInf)]++genNum :: (Precision p, Rounding r) => Gen (Number p r)+genNum = do+  c <- choose (-(10^10), 10^10) :: Gen Integer+  e <- choose (-99, 99)         :: Gen Integer+  return $ read (show c ++ 'E' : show e)++genInf :: (Precision p, Rounding r) => Gen (Number p r)+genInf = do+  s <- elements [-1, 1]+  return (s * infinity)++genNaN :: (Precision p, Rounding r) => Gen (Number p r)+genNaN = oneof [nan "", nan "s"]+  where nan kind = do+          s <- elements ["", "-"]+          p <- choose (0, 10000) :: Gen Integer+          return $ read (s ++ kind ++ "NaN" ++ show p)