Time Library darcs Repository - Fixed.hs (1/1)

Ashley Yakeley ashley at semantic.org
Fri Mar 4 04:03:24 EST 2005

I wrote:

>   darcs get "http://semantic.org/TimeLib/"
...
> I hope to get more implementation done this coming week.

I've done some more implementation, the basic calendric conversions
work. Have a look, send me any comments/concerns or better yet reply
here on the list.

One thing I am considering is using a Fixed type (a possible Data.Fixed
attached/appended) for DiffTime. This would make DiffTime an instance of
Num etc. with 1 = 1 second rather than 1 = 1 picosecond, while still
maintaining picosecond resolution (as Qrczak suggested). Opinions?

Also, I've set -fglasgow-exts, mostly to get "cunning newtype" deriving.
But presumably this lack of portability is undesirable?

--
Ashley Yakeley, Seattle WA
{-# OPTIONS -fglasgow-exts -Wall -Werror #-}

module Data.Fixed
(
Fixed,FixedResolution(..),
E6,Micro,
E12,Pico
) where

newtype Fixed a = MkFixed Integer deriving (Eq,Ord,Enum)

class FixedResolution a where
fixedResolution :: a -> Integer

instance (FixedResolution a) => Num (Fixed a) where
(MkFixed a) + (MkFixed b) = MkFixed (a + b)
(MkFixed a) - (MkFixed b) = MkFixed (a - b)
(MkFixed a) * (MkFixed b) = MkFixed (div (a * b) (fixedResolution (undefined :: a)))
negate (MkFixed a) = MkFixed (negate a)
abs (MkFixed a) = MkFixed (abs a)
signum (MkFixed a) = fromInteger (signum a)
fromInteger i = MkFixed (i * fixedResolution (undefined :: a))

instance (FixedResolution a) => Real (Fixed a) where
toRational (MkFixed a) = (toRational a) / (toRational (fixedResolution (undefined :: a)))

instance (FixedResolution a) => Fractional (Fixed a) where
(MkFixed a) / (MkFixed b) = MkFixed (div (a * (fixedResolution (undefined :: a))) b)
recip (MkFixed a) = MkFixed (div ((fixedResolution (undefined :: a)) * (fixedResolution (undefined :: a))) a)
fromRational r = MkFixed (floor (r * (toRational (fixedResolution (undefined :: a)))))

instance (FixedResolution 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)

-- only works for positive a
showIntegerZeros :: Int -> Integer -> String
showIntegerZeros digits a = replicate (digits - length s) '0' ++ s where
s = show a

instance (FixedResolution a) => Show (Fixed a) where
show (MkFixed a) | a < 0 = "-" ++ (show (MkFixed (negate a) :: Fixed a))
show (MkFixed a) = (show i) ++ "." ++ (showIntegerZeros digits fracNum) where
f = fixedResolution (undefined :: a)
(i,d) = divMod a f
-- enough digits to be unambiguous
digits = ceiling (logBase (fromInteger f) 10 :: Double)
maxnum = 10 ^ digits
fracNum = div (d * maxnum) f

data E6

instance FixedResolution E6 where
fixedResolution _ = 1000000

type Micro = Fixed E6

data E12

instance FixedResolution E12 where
fixedResolution _ = 1000000000000

type Pico = Fixed E12