diff --git a/Data/Number/LogFloat.hs b/Data/Number/LogFloat.hs --- a/Data/Number/LogFloat.hs +++ b/Data/Number/LogFloat.hs @@ -2,17 +2,19 @@ -- TODO: Make sure rewrite rules really fire -- TODO: profile to make sure we don't waste too much time constructing -- dictionaries --- TODO: investigate adding strictness annotations for register --- unboxing +-- TODO: write strict variant to unpack into registers -- TODO: write the signed variant --- + +-- Needed by our RealToFrac contexts +{-# LANGUAGE FlexibleContexts #-} + -- To turn on optimizations and look at the optimization records, cf: -- http://www.haskell.org/ghc/docs/latest/html/users_guide/rewrite-rules.html -- http://www.randomhacks.net/articles/2007/02/10/map-fusion-and-haskell-performance -- {-# OPTIONS_GHC -ddump-rules -ddump-simpl-stats #-} -{-# OPTIONS_GHC -Wall -Werror #-} +{-# OPTIONS_GHC -Wall -fwarn-tabs -Werror #-} -- Unfortunately we need -fglasgow-exts in order to actually pick -- up on the rules (see -ddump-rules). The -frewrite-rules flag @@ -22,6 +24,8 @@ {-# OPTIONS_GHC -O2 -fvia-C -optc-O3 -fexcess-precision -fglasgow-exts #-} -- Version History +-- (v0.9.0) s/toFractional/realToFrac/g. +-- Also moved realToFrac and log to Transfinite -- (v0.8.6) Removed buggy RULES -- (v0.8.5) Gave up and converted from lhs to hs so Hackage docs work -- (v0.8.4) Broke out Transfinite @@ -37,13 +41,13 @@ -- (v0.1) Initial version created for hw5 for NLP with Jason Eisner. -- ---------------------------------------------------------------- --- ~ 2008.08.17 +-- ~ 2008.08.29 -- | -- Module : Data.Number.LogFloat -- Copyright : Copyright (c) 2007--2008 wren ng thornton -- License : BSD3 -- Maintainer : wren@community.haskell.org --- Stability : stable +-- Stability : provisional -- Portability : portable -- -- This module presents a type for storing numbers in the log-domain. @@ -66,20 +70,17 @@ module Data.Number.LogFloat ( - -- * Basic functions - log, toFractional - + -- * Exceptional numeric values + module Data.Number.Transfinite + -- * @LogFloat@ data type and conversion functions , LogFloat , logFloat, logToLogFloat , fromLogFloat, logFromLogFloat - - -- * Exceptional numeric values - , module Data.Number.Transfinite ) where -import Prelude hiding (log, isNaN) -import qualified Prelude (log, isNaN) +import Prelude hiding (log, isNaN, realToFrac) +import qualified Prelude (isNaN) import Data.Number.Transfinite @@ -115,89 +116,16 @@ -- them. ----------------------------------------------------------------- --- --- | Since the normal 'Prelude.log' throws an error on zero, we --- have to redefine it in order for things to work right. Arguing --- from limits we can see that @log 0 == negativeInfinity@. Newer --- versions of GHC have this behavior already, but older versions --- and Hugs do not. --- --- This function will raise an error when taking the log of negative --- numbers, rather than returning 'notANumber' as the newer GHC --- implementation does. The reason being that typically this is a --- logical error, and @notANumber@ allows the error to propegate --- silently. --- --- In order to improve portability, the 'Transfinite' class is --- required to indicate that the 'Floating' type does in fact have --- a representation for negative infinity. Both native floating --- types ('Double' and 'Float') are supported. If you define your --- own instance of @Transfinite@, verify the above equation holds --- for your @0@ and @negativeInfinity@. If it doesn't, then you --- should avoid importing our @log@ and will probably want converters --- to handle the discrepancy when dealing with @LogFloat@s. - -{-# SPECIALIZE log :: Double -> Double #-} -log :: (Floating a, Transfinite a) => a -> a -log x = case compare x 0 of - GT -> Prelude.log x - EQ -> negativeInfinity - LT -> errorOutOfRange "log" - - --- | The most generic numeric converter I can come up with. All the --- built-in numeric types are 'Real', though 'Int' and 'Integer' --- aren't 'Fractional'. Beware that converting transfinite values --- into @Ratio@ types is error-prone and non-portable, as discussed --- in "Data.Number.Transfinite". - -{-# INLINE [1] toFractional #-} -{-# SPECIALIZE toFractional :: (Real a) => a -> Float #-} -{-# SPECIALIZE toFractional :: (Real a) => a -> Double #-} -{-# SPECIALIZE toFractional :: (Fractional b) => Double -> b #-} -toFractional :: (Real a, Fractional b) => a -> b -toFractional = fromRational . toRational - --- The INLINE pragma is to /delay/ inlining, so the rules below can --- have their way - --- This should only fire when it's type-safe -{-# RULES "toFractional/id" toFractional = id #-} - --- These too should only fire when it's type-safe +-- These should only fire when it's type-safe -- This should already happen, but... -- TODO: Check the logs to see if it ever fires --- BUG: why does -ddump-rules call these two orphaned? +-- N.B. these are orphaned {-# RULES "toRational/fromRational" forall x. toRational (fromRational x) = x "toRational.fromRational" toRational . fromRational = id #-} --- 'toFractional' should be inlined and the above rules should --- obviate this, but... --- TODO: We should check the logs to see if it ever fires before --- removing them -{-# RULES -"toFractional/toFractional" forall x. - toFractional (toFractional x) = toFractional x -"toFractional.toFractional" toFractional . toFractional = toFractional - #-} - -{- It looks like we need these for vast performance improvement. - Is there some way to include them without resorting to CPP or - other non-portability? - - -import GHC.Prim -{-# RULES "toFractional::Int->Double" toFractional = i2d #-} -i2d (I# i) = D# (int2Double# i) -{-# RULES "toFractional::Int->Float" toFractional = i2f #-} -i2f (I# i) = F# (int2Float# i) --} - - ---------------------------------------------------------------- -- -- | Reduce the number of constant string literals we need to store. @@ -259,8 +187,8 @@ -- to log-domain. {-# SPECIALIZE logFloat :: Double -> LogFloat #-} -logFloat :: (Real a) => a -> LogFloat -logFloat = LogFloat . log . guardNonNegative "logFloat" . toFractional +logFloat :: (Real a, RealToFrac a Double) => a -> LogFloat +logFloat = LogFloat . log . guardNonNegative "logFloat" . realToFrac -- This is simply a polymorphic version of the 'LogFloat' data @@ -274,23 +202,25 @@ -- log-domain. {-# SPECIALIZE logToLogFloat :: Double -> LogFloat #-} -logToLogFloat :: (Real a) => a -> LogFloat -logToLogFloat = LogFloat . guardIsANumber "logToLogFloat" . toFractional +logToLogFloat :: (Real a, RealToFrac a Double) => a -> LogFloat +logToLogFloat = LogFloat . guardIsANumber "logToLogFloat" . realToFrac -- | Return our log-domain value back into normal-domain. Beware -- of overflow\/underflow. {-# SPECIALIZE fromLogFloat :: LogFloat -> Double #-} -fromLogFloat :: (Fractional a, Transfinite a) => LogFloat -> a -fromLogFloat (LogFloat x) = toFractional (exp x) +fromLogFloat :: (Fractional a, Transfinite a, RealToFrac Double a) + => LogFloat -> a +fromLogFloat (LogFloat x) = realToFrac (exp x) -- | Return the log-domain value itself without costly conversion {-# SPECIALIZE logFromLogFloat :: LogFloat -> Double #-} -logFromLogFloat :: (Fractional a, Transfinite a) => LogFloat -> a -logFromLogFloat (LogFloat x) = toFractional x +logFromLogFloat :: (Fractional a, Transfinite a, RealToFrac Double a) + => LogFloat -> a +logFromLogFloat (LogFloat x) = realToFrac x -- These are our module-specific versions of "log\/exp" and "exp\/log"; @@ -298,7 +228,7 @@ -- the logarithm and exponentiation. -- -- In order to ensure these rules fire we may need to delay inlining --- of the four con-\/destructors, like we do for 'toFractional'. +-- of the four con-\/destructors, like we do for 'realToFrac'. -- Unfortunately, I'm not entirely sure whether they will be inlined -- already or not (and whether they are may be fragile) and I don't -- want to inline them excessively and lead to code bloat in the @@ -383,7 +313,7 @@ -- Just for fun. The more coersion functions the better. Though --- it can underflow... +-- Rationals are very buggy when it comes to transfinite values instance Real LogFloat where toRational (LogFloat x) = toRational (exp x) diff --git a/Data/Number/PartialOrd.hs b/Data/Number/PartialOrd.hs new file mode 100644 --- /dev/null +++ b/Data/Number/PartialOrd.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE OverlappingInstances + , FlexibleInstances + , UndecidableInstances + #-} + +{-# OPTIONS_GHC -Wall -fwarn-tabs -Werror #-} + +---------------------------------------------------------------- +-- ~ 2008.08.29 +-- | +-- Module : Data.Number.PartialOrd +-- Copyright : Copyright (c) 2007--2008 wren ng thornton +-- License : BSD3 +-- Maintainer : wren@community.haskell.org +-- Stability : provisional +-- Portability : portable +-- +-- The Prelude's 'Ord' class for dealing with ordered types is often +-- onerous to use because it requires 'Eq' as well as a total +-- ordering. While such total orderings are common, partial orderings +-- are moreso. This module presents a class for partially ordered +-- types. +---------------------------------------------------------------- +module Data.Number.PartialOrd (PartialOrd(..)) where + +---------------------------------------------------------------- +-- | This class defines a partially ordered type. The method names +-- were chosen so as not to conflict with 'Ord' and 'Eq'. We use +-- 'Maybe' instead of defining new types @PartialOrdering@ and +-- @FuzzyBool@ because this way should make the class easier to +-- use. + +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 + +infix 4 `gt`, `ge`, `eq`, `ne`, `le`, `lt` + +instance (Ord a) => PartialOrd a where + cmp x y = Just (compare x y) + gt x y = Just (x > y) + ge x y = Just (x >= y) + eq x y = Just (x == y) + ne x y = Just (x /= y) + le x y = Just (x <= y) + lt x y = Just (x < y) + +---------------------------------------------------------------- +----------------------------------------------------------- fin. diff --git a/Data/Number/Transfinite.hs b/Data/Number/Transfinite.hs --- a/Data/Number/Transfinite.hs +++ b/Data/Number/Transfinite.hs @@ -1,15 +1,23 @@ -{-# OPTIONS_GHC -Wall -Werror #-} +-- Needed to ensure correctness, because we can't guarantee that rules fire +{-# LANGUAGE MultiParamTypeClasses + , OverlappingInstances + #-} +-- Glasgow extensions needed to enable the # kind +{-# OPTIONS_GHC -cpp -fglasgow-exts #-} + +{-# OPTIONS_GHC -Wall -fwarn-tabs -Werror #-} + ---------------------------------------------------------------- --- ~ 2008.08.16 +-- ~ 2008.08.29 -- | -- Module : Data.Number.Transfinite -- Copyright : Copyright (c) 2007--2008 wren ng thornton -- License : BSD3 -- Maintainer : wren@community.haskell.org --- Stability : stable --- Portability : portable +-- Stability : beta +-- Portability : non-portable (CPP, MPTC, OverlappingInstances) -- -- This module presents a type class for numbers which have -- representations for transfinite values. The idea originated from @@ -24,17 +32,33 @@ -- 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 --- convert back as 'negativeInfinity'. +-- buggily convert back as 'negativeInfinity'. -- -- Hugs (September 2006) stays closer to the haskell98 spec and -- offers no way of constructing those values, raising arithmetic -- overflow errors if attempted. ---------------------------------------------------------------- -module Data.Number.Transfinite (Transfinite(..)) where +module Data.Number.Transfinite + ( Transfinite(..) + , log + , RealToFrac(..) + ) where -import Prelude hiding (isInfinite, isNaN) -import qualified Prelude (isInfinite, isNaN) +import Prelude hiding (isInfinite, isNaN, log, realToFrac) +import qualified Prelude (isInfinite, isNaN, log, realToFrac) +import Data.Number.PartialOrd + +#ifdef __GLASGOW_HASKELL__ +import GHC.Prim + ( int2Double# + , int2Float# + , double2Float# + , float2Double# + ) +import GHC.Exts (Int(..), Integer(..), Float(..), Double(..)) +#endif + ---------------------------------------------------------------- -- | Many numbers are not 'Bounded' yet, even though they can -- represent arbitrarily large values, they are not necessarily @@ -42,22 +66,17 @@ -- This class is for types which are capable of representing such -- values. Notably, this class does not require the type to be -- 'Fractional' nor 'Floating' since integral types could also have --- representations for transfinite values. +-- representations for transfinite values. By popular demand the +-- 'Num' restriction has been lifted as well, due to complications +-- of defining 'Show' or 'Eq' for some types. -- --- In particular, this class extends the 'Ord' projection to have +-- In particular, this class extends the ordered projection to have -- a maximum value 'infinity' and a minimum value 'negativeInfinity', -- as well as an exceptional value 'notANumber'. All the natural -- laws regarding @infinity@ and @negativeInfinity@ should pertain. --- Additionally, @infinity - infinity@ should return @notANumber@ --- (as should @0\/0@ and @infinity\/infinity@ if the type is --- @Fractional@). Any operations on @notANumber@ will also return --- @notANumber@, and any equality or ordering comparison on --- @notANumber@ must return @False@. --- --- Minimum complete definition is @infinity@, @isInfinite@, and --- @isNaN@. +-- (Some of these are discussed below.) -class (Num a, Ord a) => Transfinite a where +class (PartialOrd a) => Transfinite a where -- | A transfinite value which is greater than all finite values. -- Adding or subtracting any finite value is a no-op. As is @@ -65,21 +84,40 @@ -- @infinity@), and dividing by any positive finite value. Also -- obeys the law @negate infinity = negativeInfinity@ with all -- appropriate ramifications. - infinity :: a + infinity :: a + + -- | A transfinite value which is less than all finite values. -- Obeys all the same laws as @infinity@ with the appropriate -- changes for the sign difference. + negativeInfinity :: a - negativeInfinity = negate infinity + -- | An exceptional transfinite value for dealing with undefined - -- results when manipulating infinite values. Since NaN shall - -- return false for all ordering and equality operations, there - -- may be more than one machine representation of this `value'. - notANumber :: a - notANumber = infinity - infinity + -- results when manipulating infinite values. The following + -- operations must return @notANumber@, where @inf@ is any value + -- 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@ + -- must also return @notANumber@, and any equality or ordering + -- comparison on @notANumber@ must return @False@. Since it + -- returns false for equality, there may be more than one machine + -- representation of this `value'. + notANumber :: a + + -- | Return true for both @infinity@ and @negativeInfinity@, -- false for all other values. isInfinite :: a -> Bool @@ -89,15 +127,125 @@ instance Transfinite Double where - infinity = 1 / 0 - isInfinite = Prelude.isInfinite - isNaN = Prelude.isNaN + infinity = 1/0 + negativeInfinity = negate (1/0) + notANumber = 0/0 + isInfinite = Prelude.isInfinite + isNaN = Prelude.isNaN instance Transfinite Float where - infinity = 1 / 0 - isInfinite = Prelude.isInfinite - isNaN = Prelude.isNaN + infinity = 1/0 + negativeInfinity = negate (1/0) + notANumber = 0/0 + isInfinite = Prelude.isInfinite + isNaN = Prelude.isNaN + + +---------------------------------------------------------------- +-- | Since the normal 'Prelude.log' throws an error on zero, we +-- have to redefine it in order for things to work right. Arguing +-- from limits we can see that @log 0 == negativeInfinity@. Newer +-- versions of GHC have this behavior already, but older versions +-- and Hugs do not. +-- +-- This function will raise an error when taking the log of negative +-- numbers, rather than returning 'notANumber' as the newer GHC +-- implementation does. The reason being that typically this is a +-- logical error, and @notANumber@ allows the error to propegate +-- silently. +-- +-- In order to improve portability, the 'Transfinite' class is +-- required to indicate that the 'Floating' type does in fact have +-- a representation for negative infinity. Both native floating +-- types ('Double' and 'Float') are supported. If you define your +-- own instance of @Transfinite@, verify the above equation holds +-- for your @0@ and @negativeInfinity@. If it doesn't, then you +-- should avoid importing our @log@ and will probably want converters +-- to handle the discrepancy. + +{-# SPECIALIZE log :: Double -> Double #-} +{-# SPECIALIZE log :: Float -> Float #-} +log :: (Floating a, Transfinite a) => a -> a +log x = case x `cmp` 0 of + Just GT -> Prelude.log x + Just EQ -> negativeInfinity + Just LT -> err "argument out of range" + Nothing -> err "argument not comparable to 0" + where + err e = error $! "Data.Number.Transfinite.log: "++e + +-- Note, Floating ultimately requires Num, but not Ord. If PartialOrd +-- proves to be an onerous requirement on Transfinite, we could +-- hack our way around without using PartialOrd by using isNaN, (== +-- 0), ((>0).signum) but that would be less efficient. + + +---------------------------------------------------------------- +-- | The 'Prelude.realToFrac' function is defined to pivot through +-- a 'Rational' according to the haskell98 spec. This is non-portable +-- and problematic as discussed above. Since there is some resistance +-- to breaking from the spec, this class defines a reasonable variant +-- which deals with transfinite values appropriately. +-- +-- N.B. The generic instance for transfinite types uses expensive +-- checks to ensure correctness. On GHC there are specialized +-- versions which use primitive converters instead. These instances +-- are hidden from other compilers by the CPP. Be warned that the +-- instances are overlapped, so you'll need to give type signatures +-- if the arguments to 'realToFrac' are polymorphic. +-- +-- 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 + +instance RealToFrac a a where + realToFrac = id + +instance (Transfinite a, Transfinite b) => RealToFrac a b where + realToFrac x + | isNaN x = notANumber + | isInfinite x = if x > 0 then infinity + else negativeInfinity + | otherwise = Prelude.realToFrac x + + +#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) + +instance RealToFrac Int Double where + {-# INLINE realToFrac #-} + realToFrac (I# i) = D# (int2Double# i) + + +instance RealToFrac Integer Float where + -- TODO: is there a more primitive way? + realToFrac j = Prelude.realToFrac j + +instance RealToFrac Integer Double where + -- TODO: is there a more primitive way? + realToFrac j = Prelude.realToFrac j + + +instance RealToFrac Float Double where + {-# INLINE realToFrac #-} + realToFrac (F# f) = D# (float2Double# f) + +instance RealToFrac Double Float where + {-# INLINE realToFrac #-} + realToFrac (D# d) = F# (double2Float# d) +#endif ---------------------------------------------------------------- ----------------------------------------------------------- fin. diff --git a/logfloat.cabal b/logfloat.cabal --- a/logfloat.cabal +++ b/logfloat.cabal @@ -3,10 +3,10 @@ ---------------------------------------------------------------- Name: logfloat -Version: 0.8.6 +Version: 0.9.0 Cabal-Version: >= 1.2 Build-Type: Simple -Stability: stable +Stability: provisional Copyright: Copyright (c) 2007--2008 wren ng thornton License: BSD3 License-File: LICENSE @@ -24,6 +24,7 @@ Library Exposed-Modules: Data.Number.LogFloat , Data.Number.Transfinite + , Data.Number.PartialOrd Build-Depends: base ----------------------------------------------------------------