From 8d8ec31f06cfa50365780ef3f725646cf23a9550 Mon Sep 17 00:00:00 2001 From: Nick Bowler Date: Tue, 23 Feb 2010 19:54:59 -0500 Subject: [PATCH] roundable: Split out the Roundable class. This class, by itself, is not really a floating point thing. Move it into its own module. --- Data/Floating.hs | 1 - Data/Floating/Helpers.hs | 2 +- Data/Floating/Instances.hs | 21 ----------------- Data/Floating/Prelude.hs | 3 +++ Data/Floating/Types/CMath.hs | 1 + Data/Floating/Types/Core.hs | 28 +---------------------- Data/Floating/Types/Double.hs | 1 + Data/Floating/Types/Float.hs | 1 + Data/Roundable.hs | 53 +++++++++++++++++++++++++++++++++++++++++++ altfloat.cabal | 6 ++--- 10 files changed, 64 insertions(+), 53 deletions(-) delete mode 100644 Data/Floating/Instances.hs create mode 100644 Data/Roundable.hs diff --git a/Data/Floating.hs b/Data/Floating.hs index 6fb5759..29e7ec9 100644 --- a/Data/Floating.hs +++ b/Data/Floating.hs @@ -15,7 +15,6 @@ module Data.Floating ( import Prelude hiding (RealFloat(..), RealFrac(..), Double, Float) import Data.Floating.Types.Core hiding (Double, Float, FloatConvert) -import Data.Floating.Instances import Data.Floating.Types.Double import Data.Floating.Types.Float import Data.Floating.Environment diff --git a/Data/Floating/Helpers.hs b/Data/Floating/Helpers.hs index ca9a443..ea53f56 100644 --- a/Data/Floating/Helpers.hs +++ b/Data/Floating/Helpers.hs @@ -14,7 +14,7 @@ module Data.Floating.Helpers ( import Prelude hiding (Double, RealFloat(..), RealFrac(..)) import Data.Floating.Types.Core -import Data.Floating.Instances +import Data.Roundable import Data.Ratio import Data.Maybe diff --git a/Data/Floating/Instances.hs b/Data/Floating/Instances.hs deleted file mode 100644 index 59906c6..0000000 --- a/Data/Floating/Instances.hs +++ /dev/null @@ -1,21 +0,0 @@ -{- - - Copyright (C) 2009 Nick Bowler. - - - - License BSD2: 2-clause BSD license. See LICENSE for full terms. - - This is free software: you are free to change and redistribute it. - - There is NO WARRANTY, to the extent permitted by law. - -} - -module Data.Floating.Instances where - -import qualified Prelude -import Prelude hiding (round, floor, ceiling, truncate) -import Data.Floating.Types.Core -import Data.Ratio - -instance Integral a => Roundable (Ratio a) where - toIntegral = Just . fst . properFraction - round x - | abs frac >= 1%2 = int%1 + signum frac - | otherwise = int%1 - where (int, frac) = properFraction x diff --git a/Data/Floating/Prelude.hs b/Data/Floating/Prelude.hs index 5861981..a55a60b 100644 --- a/Data/Floating/Prelude.hs +++ b/Data/Floating/Prelude.hs @@ -11,6 +11,7 @@ -- Prelude operations that do not conflict. module Data.Floating.Prelude ( module Data.Floating, + module Data.Roundable, module Data.Poset, module Prelude ) where @@ -21,5 +22,7 @@ import Prelude hiding ( Double, Float, round, truncate, ceiling, floor ) + import Data.Floating +import Data.Roundable import Data.Poset diff --git a/Data/Floating/Types/CMath.hs b/Data/Floating/Types/CMath.hs index ff6e632..9f6d1d9 100644 --- a/Data/Floating/Types/CMath.hs +++ b/Data/Floating/Types/CMath.hs @@ -17,6 +17,7 @@ import Data.Floating.Types.Float import Data.Floating.Types.Core import Foreign.C +import Data.Roundable import Data.Poset doubleLibm :: (Double -> Double) -> CDouble -> CDouble diff --git a/Data/Floating/Types/Core.hs b/Data/Floating/Types/Core.hs index 909376c..d3c2ff3 100644 --- a/Data/Floating/Types/Core.hs +++ b/Data/Floating/Types/Core.hs @@ -14,7 +14,7 @@ module Data.Floating.Types.Core where import Prelude hiding (Double, Float, Ord(..), RealFrac(..), Floating(..), RealFloat(..)) import Data.Ratio -import Data.Poset +import Data.Roundable import GHC.Integer import GHC.Prim @@ -33,32 +33,6 @@ data Float = F# Float# data FPClassification = FPInfinite | FPNaN | FPNormal | FPSubNormal | FPZero deriving (Show, Read, Eq, Enum, Bounded) --- | Class for types which can be rounded to integers. The rounding functions --- in the Prelude are inadequate for floating point because they shoehorn their --- results into an integral type. --- --- Minimal complete definition: 'toIntegral' and 'round'. -class (Fractional a, Poset a) => Roundable a where - -- | Discards the fractional component from a value. Results in 'Nothing' - -- if the result cannot be represented as an integer, such as if the input - -- is infinite or NaN. - toIntegral :: Integral b => a -> Maybe b - ceiling :: a -> a - floor :: a -> a - truncate :: a -> a - round :: a -> a - - floor x - | round x == x = x - | otherwise = round $ x - fromRational (1%2) - ceiling x - | round x == x = x - | otherwise = round $ x + fromRational (1%2) - truncate x - | x < 0 = ceiling x - | x > 0 = floor x - | otherwise = x - -- | Class for floating point types (real or complex-valued). -- -- Minimal complete definition: everything. diff --git a/Data/Floating/Types/Double.hs b/Data/Floating/Types/Double.hs index daf55c4..285e050 100644 --- a/Data/Floating/Types/Double.hs +++ b/Data/Floating/Types/Double.hs @@ -19,6 +19,7 @@ import Control.Applicative import Control.Monad import Data.Maybe import Data.Ratio +import Data.Roundable import Data.Poset import GHC.Exts hiding (Double(..)) diff --git a/Data/Floating/Types/Float.hs b/Data/Floating/Types/Float.hs index d6d9f8f..3100fe8 100644 --- a/Data/Floating/Types/Float.hs +++ b/Data/Floating/Types/Float.hs @@ -19,6 +19,7 @@ import Control.Applicative import Control.Monad import Data.Maybe import Data.Ratio +import Data.Roundable import Data.Poset import GHC.Exts hiding (Float(..)) diff --git a/Data/Roundable.hs b/Data/Roundable.hs new file mode 100644 index 0000000..041ac9c --- /dev/null +++ b/Data/Roundable.hs @@ -0,0 +1,53 @@ +{- + - Copyright (C) 2009-2010 Nick Bowler. + - + - License BSD2: 2-clause BSD license. See LICENSE for full terms. + - This is free software: you are free to change and redistribute it. + - There is NO WARRANTY, to the extent permitted by law. + -} + +-- | A replacement for the 'RealFrac' class which is usable by floating point +-- types. The functions in 'RealFrac' shoehorn their results into an integer, +-- which means they simply cannot be defined sensibly for infinities or NaNs. +module Data.Roundable where + +import Prelude hiding (Ord(..), ceiling, floor, truncate, round) +import Data.Ratio +import Data.Poset + +-- | Class for ordered numeric types which embed a subset of the integers. +-- +-- Minimal complete definition: 'toIntegral' and 'round'. +class (Fractional a, Poset a) => Roundable a where + -- | Discards the fractional component from a value. Results in 'Nothing' + -- if the result cannot be represented as an integer, such as if the input + -- is infinite or NaN. + toIntegral :: Integral b => a -> Maybe b + -- | Determine the least integer not less than the input. + ceiling :: a -> a + -- | Determine the greatest integer not greater than the input. + floor :: a -> a + -- | Determine the greatest integer whose absolute value is not greater + -- than the input. + truncate :: a -> a + -- | Determine the integer closest to the input. In case of a tie, the + -- integer largest in absolute value is chosen. + round :: a -> a + + floor x + | round x == x = x + | otherwise = round $ x - fromRational (1%2) + ceiling x + | round x == x = x + | otherwise = round $ x + fromRational (1%2) + truncate x + | x < 0 = ceiling x + | x > 0 = floor x + | otherwise = x + +instance Integral a => Roundable (Ratio a) where + toIntegral = Just . fst . properFraction + round x + | abs frac >= 1%2 = int%1 + signum frac + | otherwise = int%1 + where (int, frac) = properFraction x diff --git a/altfloat.cabal b/altfloat.cabal index 4576dd1..e303eb5 100644 --- a/altfloat.cabal +++ b/altfloat.cabal @@ -83,7 +83,7 @@ Library Data.Floating.Prelude, Data.Floating.Environment, Data.Floating, - Data.Poset + Data.Poset, + Data.Roundable Other-Modules: - Data.Floating.Instances, Data.Floating.Helpers, - Data.Poset.Internal, Data.Poset.Instances + Data.Floating.Helpers, Data.Poset.Internal, Data.Poset.Instances -- 2.11.4.GIT