diff --git a/Data/Number/LogFloat.hs b/Data/Number/LogFloat.hs --- a/Data/Number/LogFloat.hs +++ b/Data/Number/LogFloat.hs @@ -83,6 +83,7 @@ import qualified Prelude (isNaN) import Data.Number.Transfinite +import Data.Number.PartialOrd ---------------------------------------------------------------- -- @@ -180,7 +181,12 @@ -- if you can parenthesize to do plain operations first, do it! newtype LogFloat = LogFloat Double - deriving (Eq, Ord) + deriving (Eq, Ord) -- Should we really perpetuate the Ord lie? + +instance PartialOrd LogFloat where + cmp (LogFloat x) (LogFloat y) + | isNaN x || isNaN y = Nothing + | otherwise = Just (x `compare` y) -- | A constructor which does semantic conversion from normal-domain diff --git a/Data/Number/PartialOrd.hs b/Data/Number/PartialOrd.hs --- a/Data/Number/PartialOrd.hs +++ b/Data/Number/PartialOrd.hs @@ -13,7 +13,7 @@ -- License : BSD3 -- Maintainer : wren@community.haskell.org -- Stability : provisional --- Portability : portable +-- Portability : semi-portable (overlapping instances, etc) -- -- The Prelude's 'Ord' class for dealing with ordered types is often -- onerous to use because it requires 'Eq' as well as a total @@ -29,15 +29,47 @@ -- 'Maybe' instead of defining new types @PartialOrdering@ and -- @FuzzyBool@ because this way should make the class easier to -- use. +-- +-- Minimum complete definition: 'cmp' class PartialOrd a where - cmp :: a -> a -> Maybe Ordering - gt :: a -> a -> Maybe Bool - ge :: a -> a -> Maybe Bool - eq :: a -> a -> Maybe Bool - ne :: a -> a -> Maybe Bool - le :: a -> a -> Maybe Bool - lt :: a -> a -> Maybe Bool + cmp :: a -> a -> Maybe Ordering + + gt :: a -> a -> Maybe Bool + gt x y = case x `cmp` y of + Just GT -> Just True + Just _ -> Just False + Nothing -> Nothing + + ge :: a -> a -> Maybe Bool + ge x y = case x `cmp` y of + Just LT -> Just False + Just _ -> Just True + Nothing -> Nothing + + eq :: a -> a -> Maybe Bool + eq x y = case x `cmp` y of + Just EQ -> Just True + Just _ -> Just False + Nothing -> Nothing + + ne :: a -> a -> Maybe Bool + ne x y = case x `cmp` y of + Just EQ -> Just False + Just _ -> Just True + Nothing -> Nothing + + le :: a -> a -> Maybe Bool + le x y = case x `cmp` y of + Just GT -> Just False + Just _ -> Just True + Nothing -> Nothing + + lt :: a -> a -> Maybe Bool + lt x y = case x `cmp` y of + Just LT -> Just True + Just _ -> Just False + Nothing -> Nothing infix 4 `gt`, `ge`, `eq`, `ne`, `le`, `lt` @@ -49,6 +81,15 @@ ne x y = Just (x /= y) le x y = Just (x <= y) lt x y = Just (x < y) + +-- The instances inherited from Ord are wrong +instance PartialOrd Float where + cmp x y | isNaN x || isNaN y = Nothing + | otherwise = Just (x `compare` y) + +instance PartialOrd Double where + cmp x y | isNaN x || isNaN y = Nothing + | otherwise = Just (x `compare` y) ---------------------------------------------------------------- ----------------------------------------------------------- fin. diff --git a/Data/Number/Transfinite.hs b/Data/Number/Transfinite.hs --- a/Data/Number/Transfinite.hs +++ b/Data/Number/Transfinite.hs @@ -32,7 +32,12 @@ -- is used on an infinite floating value, the result is a rational -- with a numerator sufficiently large that it will overflow when -- converted back to a @Double@. If used on NaN, the result would --- buggily convert back as 'negativeInfinity'. +-- buggily convert back as 'negativeInfinity'. For more discussion +-- on why this approach is problematic, see: +-- +-- * +-- +-- * -- -- Hugs (September 2006) stays closer to the haskell98 spec and -- offers no way of constructing those values, raising arithmetic @@ -56,7 +61,7 @@ , double2Float# , float2Double# ) -import GHC.Exts (Int(..), Integer(..), Float(..), Double(..)) +import GHC.Exts (Int(..), Float(..), Double(..)) #endif ---------------------------------------------------------------- @@ -101,12 +106,19 @@ -- which @isInfinite@: -- -- * @inf + inf@ + -- -- * @inf - inf@ + -- -- * @inf * 0@ + -- -- * @0 * inf@ + -- -- * @inf \/ inf@ + -- -- * @inf `div` inf@ + -- -- * @0 \/ 0@ + -- -- * @0 `div` 0@ -- -- Additionally, any mathematical operations on @notANumber@ @@ -197,17 +209,16 @@ -- -- If any of these restrictions (CPP, GHC-only, OverlappingInstances) -- are onerous to you, contact the maintainer (we like patches :) --- --- * --- * -class RealToFrac a b where - realToFrac :: (Real a, Fractional b) => a -> b +class (Real a, Fractional b) => RealToFrac a b where + realToFrac :: a -> b -instance RealToFrac a a where +instance (Real a, Fractional a) => RealToFrac a a where realToFrac = id -instance (Transfinite a, Transfinite b) => RealToFrac a b where +instance (Real a, Transfinite a, Fractional b, Transfinite b) + => RealToFrac a b + where realToFrac x | isNaN x = notANumber | isInfinite x = if x > 0 then infinity @@ -216,10 +227,6 @@ #ifdef __GLASGOW_HASKELL__ -instance RealToFrac Int Integer where - {-# INLINE realToFrac #-} - realToFrac (I# i) = S# i - instance RealToFrac Int Float where {-# INLINE realToFrac #-} realToFrac (I# i) = F# (int2Float# i) diff --git a/logfloat.cabal b/logfloat.cabal --- a/logfloat.cabal +++ b/logfloat.cabal @@ -1,9 +1,9 @@ ---------------------------------------------------------------- --- wren ng thornton ~ 2008.08.17 +-- wren ng thornton ~ 2008.08.29 ---------------------------------------------------------------- Name: logfloat -Version: 0.9.0 +Version: 0.9.1 Cabal-Version: >= 1.2 Build-Type: Simple Stability: provisional