{- - 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. -} -- | Generic classes for floating point types. The interface is loosely based -- off of the C math library. module Data.Floating.Classes where import Prelude hiding (Floating(..), RealFloat(..), RealFrac(..), Ord(..)) import Data.Ratio import Data.Poset -- | Classification of floating point values. 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. class Fractional a => Floating a where (**) :: a -> a -> a sqrt :: a -> a acos :: a -> a asin :: a -> a atan :: a -> a cos :: a -> a sin :: a -> a tan :: a -> a acosh :: a -> a asinh :: a -> a atanh :: a -> a cosh :: a -> a sinh :: a -> a tanh :: a -> a exp :: a -> a log :: a -> a -- | Class for real-valued floating point types. -- -- Minimal complete definition: all except 'pi', 'infinity' and 'nan'. class Floating a => RealFloat a where -- | Fused multiply-add. fma :: a -> a -> a -> a -- | @copysign x y@ computes a value with the magnitude of @x@ but the sign -- of @y@. copysign :: a -> a -> a -- | @nextafter x y@ computes the next representable value after @x@ in the -- direction of @y@. nextafter :: a -> a -> a -- | @atan2 y x@ computes the principal value of the arctangent of @y/x@. -- The signs of the input determine the quadrant of the result. atan2 :: a -> a -> a -- | @fmod x y@ computes @x - n*y@, where @n@ is the integral quotient of -- @x/y@, rounded towards zero. fmod :: a -> a -> a -- | @frem x y@ computes @x - n*y@, where @n@ is the integral quotient of -- @x/y@, rounded to the nearest integer, with halfway values rounded to -- even. frem :: a -> a -> a -- | Euclidean distance function without undue overflow. hypot :: a -> a -> a -- | Cube root. cbrt :: a -> a -- | Base-2 exponential function. exp2 :: a -> a -- | Computes @exp x - 1@ without undue cancellation. expm1 :: a -> a -- | Base-10 logarithm function. log10 :: a -> a -- | Computes @log (x + 1)@ without undue cancellation. log1p :: a -> a -- | Base-2 logarithm function. log2 :: a -> a -- | Extracts the exponent of a floating point value. If the value is -- subnormal, the result is as if the value were normalized. logb :: a -> a -- | Error function. erf :: a -> a -- | Complementary error function. erfc :: a -> a -- | Gamma function. gamma :: a -> a -- | Log gamma function. lgamma :: a -> a -- | Round to the nearest integer according to the current rounding -- direction. The default rounding direction is towards the nearest -- integer with halfway values rounded to even. If the resulting value -- differs from the input, the 'Inexact' exception is raised. rint :: a -> a -- | Same as 'rint', except that the 'Inexact' exception is not raised. nearbyint :: a -> a infinity :: a nan :: a pi :: a infinity = 1/0 nan = 0/0 pi = 4 * atan 1 -- | Class for the basic floating point types. class (Roundable a, RealFloat a) => PrimFloat a where classify :: a -> FPClassification