X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FFixed.hs;h=73f57fc1278a1cf3aeff08330af1fb0abe2e4a5e;hb=1bd512fe5b2b52e2329b5e7e0cdf91587326abee;hp=f2f96e97c337b1c7a39b759216996b10890048c7;hpb=6ec0a71d8daa9728a9c93bcbfa443d9310423d98;p=ghc-base.git diff --git a/Data/Fixed.hs b/Data/Fixed.hs index f2f96e9..73f57fc 100644 --- a/Data/Fixed.hs +++ b/Data/Fixed.hs @@ -23,12 +23,12 @@ module Data.Fixed ( - div',mod',divMod', + div',mod',divMod', - Fixed,HasResolution(..), - showFixed, - E6,Micro, - E12,Pico + Fixed,HasResolution(..), + showFixed, + E6,Micro, + E12,Pico ) where import Prelude -- necessary to get dependencies right @@ -40,22 +40,22 @@ div' n d = floor ((toRational n) / (toRational d)) -- | generalisation of 'divMod' to any instance of Real divMod' :: (Real a,Integral b) => a -> a -> (b,a) divMod' n d = (f,n - (fromIntegral f) * d) where - f = div' n d + f = div' n d -- | generalisation of 'mod' to any instance of Real mod' :: (Real a) => a -> a -> a mod' n d = n - (fromInteger f) * d where - f = div' n d + f = div' n d newtype Fixed a = MkFixed Integer deriving (Eq,Ord) class HasResolution a where - resolution :: a -> Integer + resolution :: a -> Integer fixedResolution :: (HasResolution a) => Fixed a -> Integer fixedResolution fa = resolution (uf fa) where - uf :: Fixed a -> a - uf _ = undefined + uf :: Fixed a -> a + uf _ = undefined withType :: (a -> f a) -> f a withType foo = foo undefined @@ -64,40 +64,40 @@ withResolution :: (HasResolution a) => (Integer -> f a) -> f a withResolution foo = withType (foo . resolution) instance Enum (Fixed a) where - succ (MkFixed a) = MkFixed (succ a) - pred (MkFixed a) = MkFixed (pred a) - toEnum = MkFixed . toEnum - fromEnum (MkFixed a) = fromEnum a - enumFrom (MkFixed a) = fmap MkFixed (enumFrom a) - enumFromThen (MkFixed a) (MkFixed b) = fmap MkFixed (enumFromThen a b) - enumFromTo (MkFixed a) (MkFixed b) = fmap MkFixed (enumFromTo a b) - enumFromThenTo (MkFixed a) (MkFixed b) (MkFixed c) = fmap MkFixed (enumFromThenTo a b c) + succ (MkFixed a) = MkFixed (succ a) + pred (MkFixed a) = MkFixed (pred a) + toEnum = MkFixed . toEnum + fromEnum (MkFixed a) = fromEnum a + enumFrom (MkFixed a) = fmap MkFixed (enumFrom a) + enumFromThen (MkFixed a) (MkFixed b) = fmap MkFixed (enumFromThen a b) + enumFromTo (MkFixed a) (MkFixed b) = fmap MkFixed (enumFromTo a b) + enumFromThenTo (MkFixed a) (MkFixed b) (MkFixed c) = fmap MkFixed (enumFromThenTo a b c) instance (HasResolution a) => Num (Fixed a) where - (MkFixed a) + (MkFixed b) = MkFixed (a + b) - (MkFixed a) - (MkFixed b) = MkFixed (a - b) - fa@(MkFixed a) * (MkFixed b) = MkFixed (div (a * b) (fixedResolution fa)) - negate (MkFixed a) = MkFixed (negate a) - abs (MkFixed a) = MkFixed (abs a) - signum (MkFixed a) = fromInteger (signum a) - fromInteger i = withResolution (\res -> MkFixed (i * res)) + (MkFixed a) + (MkFixed b) = MkFixed (a + b) + (MkFixed a) - (MkFixed b) = MkFixed (a - b) + fa@(MkFixed a) * (MkFixed b) = MkFixed (div (a * b) (fixedResolution fa)) + negate (MkFixed a) = MkFixed (negate a) + abs (MkFixed a) = MkFixed (abs a) + signum (MkFixed a) = fromInteger (signum a) + fromInteger i = withResolution (\res -> MkFixed (i * res)) instance (HasResolution a) => Real (Fixed a) where - toRational fa@(MkFixed a) = (toRational a) / (toRational (fixedResolution fa)) + toRational fa@(MkFixed a) = (toRational a) / (toRational (fixedResolution fa)) instance (HasResolution a) => Fractional (Fixed a) where - fa@(MkFixed a) / (MkFixed b) = MkFixed (div (a * (fixedResolution fa)) b) - recip fa@(MkFixed a) = MkFixed (div (res * res) a) where - res = fixedResolution fa - fromRational r = withResolution (\res -> MkFixed (floor (r * (toRational res)))) + fa@(MkFixed a) / (MkFixed b) = MkFixed (div (a * (fixedResolution fa)) b) + recip fa@(MkFixed a) = MkFixed (div (res * res) a) where + res = fixedResolution fa + fromRational r = withResolution (\res -> MkFixed (floor (r * (toRational res)))) instance (HasResolution a) => RealFrac (Fixed a) where - properFraction a = (i,a - (fromIntegral i)) where - i = truncate a - truncate f = truncate (toRational f) - round f = round (toRational f) - ceiling f = ceiling (toRational f) - floor f = floor (toRational f) + properFraction a = (i,a - (fromIntegral i)) where + i = truncate a + truncate f = truncate (toRational f) + round f = round (toRational f) + ceiling f = ceiling (toRational f) + floor f = floor (toRational f) chopZeros :: Integer -> String chopZeros 0 = "" @@ -108,8 +108,8 @@ chopZeros a = show a showIntegerZeros :: Bool -> Int -> Integer -> String showIntegerZeros True _ 0 = "" showIntegerZeros chopTrailingZeros digits a = replicate (digits - length s) '0' ++ s' where - s = show a - s' = if chopTrailingZeros then chopZeros a else s + s = show a + s' = if chopTrailingZeros then chopZeros a else s withDot :: String -> String withDot "" = "" @@ -119,22 +119,22 @@ withDot s = '.':s showFixed :: (HasResolution a) => Bool -> Fixed a -> String showFixed chopTrailingZeros fa@(MkFixed a) | a < 0 = "-" ++ (showFixed chopTrailingZeros (asTypeOf (MkFixed (negate a)) fa)) showFixed chopTrailingZeros fa@(MkFixed a) = (show i) ++ (withDot (showIntegerZeros chopTrailingZeros digits fracNum)) where - res = fixedResolution fa - (i,d) = divMod a res - -- enough digits to be unambiguous - digits = ceiling (logBase 10 (fromInteger res) :: Double) - maxnum = 10 ^ digits - fracNum = div (d * maxnum) res + res = fixedResolution fa + (i,d) = divMod a res + -- enough digits to be unambiguous + digits = ceiling (logBase 10 (fromInteger res) :: Double) + maxnum = 10 ^ digits + fracNum = div (d * maxnum) res instance (HasResolution a) => Show (Fixed a) where - show = showFixed False + show = showFixed False data E6 = E6 instance HasResolution E6 where - resolution _ = 1000000 + resolution _ = 1000000 type Micro = Fixed E6 @@ -142,6 +142,6 @@ type Micro = Fixed E6 data E12 = E12 instance HasResolution E12 where - resolution _ = 1000000000000 + resolution _ = 1000000000000 type Pico = Fixed E12