fixed-point 0.3.0.0 → 0.4.0.0

raw patch · 2 files changed

+89/−36 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Data/Fixed/Binary.hs +87/−34
• fixed-point.cabal +2/−2

@@ -26,8 +26,8 @@        , E0, E1, E2, E4, E8, E10, E16, E20, E30, E32, E64        , S, P        , fixedRadix, fixedSize, fromRealFloat-       , (:+), (*.)-       , (:-), (/.)+       , (:+), (*.), (*!)+       , (:-), (/.), (/!)        ) where  import Control.Applicative@@ -55,7 +55,7 @@ -- eight bits for the integer component (of which one bit is used for -- the sign) and eight bits for the fractional component. newtype Fixed r a = Fixed { unFixed :: a }-                  deriving (Enum, Eq, Ord, Typeable)+                  deriving (Bounded, Enum, Eq, Ord, Typeable)  newtype instance VU.MVector s (Fixed r a) = MVFixed { unMVFixed :: VU.MVector s a } newtype instance VU.Vector    (Fixed r a) = VFixed  { unVFixed  :: VU.Vector    a }@@ -157,54 +157,54 @@  instance ( HasResolution r, Bits a, Bits (Super a), Integral a, Num (Super a)          , Integral (Super a), SuperTypeable a) => Num (Fixed r a) where-  {-# INLINABLE (+) #-}+  {-# INLINE (+) #-}   (+) = inFixed2 (+)-  {-# INLINABLE (-) #-}+  {-# INLINE (-) #-}   (-) = inFixed2 (-)-  {-# INLINABLE (*) #-}-  Fixed x * Fixed y = withResolution $ Fixed . subCast . shiftR (superCast x * superCast y)-  {-# INLINABLE negate #-}+  {-# INLINE (*) #-}+  (*) = fmap subCast . (*!) `on` superCast+  {-# INLINE negate #-}   negate = inFixed negate-  {-# INLINABLE abs #-}+  {-# INLINE abs #-}   abs = inFixed abs-  {-# INLINABLE signum #-}+  {-# INLINE signum #-}   signum (Fixed x) = withResolution $ \s -> Fixed $ signum x `shiftL` s-  {-# INLINABLE fromInteger #-}+  {-# INLINE fromInteger #-}   fromInteger i = withResolution $ Fixed . shiftL (fromInteger i)  instance ( HasResolution r, Bits a, Bits (Super a), Integral a          , Integral (Super a), SuperTypeable a) => Real (Fixed r a) where-  {-# INLINABLE toRational #-}+  {-# INLINE toRational #-}   toRational x = toRational (unFixed x) / toRational (2 ^ resolution x :: Integer)  instance ( HasResolution r, Bits a, Bits (Super a), Integral a          , Integral (Super a), SuperTypeable a) => Fractional (Fixed r a) where-  -- TODO Could I use quot instead of div at all here?-  {-# INLINABLE (/) #-}-  a / b = Fixed . subCast $ (superCast (unFixed a) `shiftL` resolution a) `div` superCast (unFixed b)-  {-# INLINABLE recip #-}-  recip x = Fixed . subCast $ (1 `shiftL` (2 * resolution x)) `div` superCast (unFixed x)-  {-# INLINABLE fromRational #-}+  {-# INLINE (/) #-}+  (/) = fmap subCast . (/!) `on` superCast+  {-# INLINE recip #-}+  recip x = Fixed . subCast $ (1 `shiftL` (2 * resolution x)) `eucQuot` superCast (unFixed x)+  {-# INLINE fromRational #-}   fromRational r = withResolution $ \s ->     Fixed . floor $ (numerator r `shiftL` s) % denominator r +-- TODO Make these more efficient. instance ( HasResolution r, Bits a, Bits (Super a), Integral a          , Integral (Super a), SuperTypeable a) => RealFrac (Fixed r a) where-  {-# INLINABLE properFraction #-}+  {-# INLINE properFraction #-}   properFraction a = let i = truncate a in (i, a - fromIntegral i)-  {-# INLINABLE truncate #-}+  {-# INLINE truncate #-}   truncate = truncate . toRational-  {-# INLINABLE round #-}+  {-# INLINE round #-}   round = round . toRational-  {-# INLINABLE ceiling #-}+  {-# INLINE ceiling #-}   ceiling = ceiling . toRational-  {-# INLINABLE floor #-}+  {-# INLINE floor #-}   floor = floor . toRational  -- | Fast conversion between fixed-point numbers with the same -- fractional size. fixedRadix :: (Integral a, Num b) => Fixed r a -> Fixed r b-{-# INLINABLE fixedRadix #-}+{-# INLINE fixedRadix #-} fixedRadix = inFixed fromIntegral  -- TODO Can't I write this as one awesome, polymorphic rule?@@ -225,37 +225,55 @@ -- | Fast conversion between fixed-point numbers with the same -- representation size. fixedSize :: (HasResolution r, HasResolution s, Bits a) => Fixed r a -> Fixed s a-{-# INLINABLE fixedSize #-}+{-# INLINE fixedSize #-} fixedSize x = withResolution $ \s -> Fixed $ unFixed x `shift` (s - resolution x) -- TODO Rewrite rules?  -- | Multiplication without throwing away fractional information. (*.) :: (Num (Super a), SuperTypeable a) => Fixed r a -> Fixed s a -> Fixed (r :+ s) a-{-# INLINABLE (*.) #-}+{-# INLINE (*.) #-} (*.) = inFixed2 ((fmap subCast . (*)) `on` superCast) --- | Division without throwing away fractional information. Same--- caveats apply as with '(*.)'.+-- | Division while removing unnecessary bits in the result's+-- fractional part. (/.) :: Integral a => Fixed r a -> Fixed s a -> Fixed (r :- s) a-{-# INLINABLE (/.) #-}-(/.) = inFixed2 div+{-# INLINE (/.) #-}+(/.) = inFixed2 eucQuot +-- | Perform a multiplication without adding any extra bits for the+-- intermediate steps. This may be faster (especially when you are+-- already working with native-sized integer data), but it's only safe+-- to use if you are sure that the multiplication won't+-- overflow. Normal multiplication is equivalent to @\x y -> subCast+-- (superCast x *!  superCast y)@.+(*!) :: (HasResolution r, Bits a, Num a) => Fixed r a -> Fixed r a -> Fixed r a+{-# INLINE (*!) #-}+Fixed x *! Fixed y = withResolution $ Fixed . shiftR (x * y)++-- | Perform a division without adding any extra bits for the+-- intermediate steps. This may be faster if supercasting brings it up+-- to a non-native size, but you need to be sure that the shifting+-- before the division won't cause an overflow.+(/!) :: (HasResolution r, Bits a, Integral a) => Fixed r a -> Fixed r a -> Fixed r a+{-# INLINE (/!) #-}+a /! b = Fixed $ (unFixed a `shiftL` resolution a) `eucQuot` unFixed b+ -- TODO Don't assume it's a binary float so that we can actually -- expose this function. toRealFloat :: (HasResolution r, Integral a, RealFloat b) => Fixed r a -> b-{-# INLINABLE toRealFloat #-}+{-# INLINE toRealFloat #-} toRealFloat = liftA2 encodeFloat (fromIntegral . unFixed) (negate . resolution) {-# SPECIALIZE toRealFloat :: (HasResolution r, Integral a) => Fixed r a -> Float #-} {-# SPECIALIZE toRealFloat :: (HasResolution r, Integral a) => Fixed r a -> Double #-}  {-# RULES-"realToFrac/Float" forall (x :: (HasResolution r, Integral a) => Fixed r a). realToFrac x = toRealFloat x :: Float+"realToFrac/Float"  forall (x :: (HasResolution r, Integral a) => Fixed r a). realToFrac x = toRealFloat x :: Float "realToFrac/Double" forall (x :: (HasResolution r, Integral a) => Fixed r a). realToFrac x = toRealFloat x :: Double   #-}  -- | Fast conversion from floating-point to fixed-point. fromRealFloat :: (RealFloat a, HasResolution r, Num b) => a -> Fixed r b-{-# INLINABLE fromRealFloat #-}+{-# INLINE fromRealFloat #-} fromRealFloat x = let (s,e) = decodeFloat x                   in withResolution $ \t -> Fixed . fromIntegral $ shiftBaseExp s (floatRadix x) (t + e) {-# SPECIALIZE fromRealFloat :: (HasResolution r, Num b) => Float -> Fixed r b #-}@@ -263,7 +281,7 @@ -- TODO Rewrite rules?  shiftBaseExp :: Integer -> Integer -> Int -> Integer-shiftBaseExp x b e | e < 0     = x `div` (b ^ negate e)+shiftBaseExp x b e | e < 0     = x `eucQuot` (b ^ negate e)                    | otherwise = x * (b ^ e)  data E0@@ -320,30 +338,44 @@   -- | Cast to a subtype. Information may be lost.   subCast :: Super a -> a +{-# RULES+"subCast . superCast" subCast . superCast = id+  #-}+ instance (SuperTypeable a, Num a, Num (Super a), Integral a, Integral (Super a)) =>          SuperTypeable (Fixed r a) where   type Super (Fixed r a) = Fixed r (Super a)+  {-# INLINE superCast #-}   superCast = fixedRadix+  {-# INLINE subCast #-}   subCast = fixedRadix  instance SuperTypeable Word8 where   type Super Word8 = Word16+  {-# INLINE superCast #-}   superCast = fromIntegral+  {-# INLINE subCast #-}   subCast = fromIntegral  instance SuperTypeable Word16 where   type Super Word16 = Word32+  {-# INLINE superCast #-}   superCast = fromIntegral+  {-# INLINE subCast #-}   subCast = fromIntegral  instance SuperTypeable Word32 where   type Super Word32 = Word64+  {-# INLINE superCast #-}   superCast = fromIntegral+  {-# INLINE subCast #-}   subCast = fromIntegral  instance SuperTypeable Word64 where   type Super Word64 = Integer+  {-# INLINE superCast #-}   superCast = fromIntegral+  {-# INLINE subCast #-}   subCast = fromIntegral  instance SuperTypeable Word where@@ -352,27 +384,37 @@ #else   type Super Word = Integer #endif+  {-# INLINE superCast #-}   superCast = fromIntegral+  {-# INLINE subCast #-}   subCast = fromIntegral  instance SuperTypeable Int8 where   type Super Int8 = Int16+  {-# INLINE superCast #-}   superCast = fromIntegral+  {-# INLINE subCast #-}   subCast = fromIntegral  instance SuperTypeable Int16 where   type Super Int16 = Int32+  {-# INLINE superCast #-}   superCast = fromIntegral+  {-# INLINE subCast #-}   subCast = fromIntegral  instance SuperTypeable Int32 where   type Super Int32 = Int64+  {-# INLINE superCast #-}   superCast = fromIntegral+  {-# INLINE subCast #-}   subCast = fromIntegral  instance SuperTypeable Int64 where   type Super Int64 = Integer+  {-# INLINE superCast #-}   superCast = fromIntegral+  {-# INLINE subCast #-}   subCast = fromIntegral  instance SuperTypeable Int where@@ -381,10 +423,21 @@ #else   type Super Int = Integer #endif+  {-# INLINE superCast #-}   superCast = fromIntegral+  {-# INLINE subCast #-}   subCast = fromIntegral  instance SuperTypeable Integer where   type Super Integer = Integer+  {-# INLINE superCast #-}   superCast = id+  {-# INLINE subCast #-}   subCast = id++eucQuot :: Integral a => a -> a -> a+{-# INLINE eucQuot #-}+a `eucQuot` b+  | a >= 0    = a `quot` b+  | b >  0    = ((a + 1) `quot` b) - 1+  | otherwise = ((a + 1) `quot` b) + 1

@@ -1,5 +1,5 @@ Name:                fixed-point-Version:             0.3.0.0+Version:             0.4.0.0 Synopsis:            Binary fixed-point arithmetic Description:         This package defines a type for binary                      fixed-precision arithmetic. The main differences@@ -50,4 +50,4 @@ source-repository this   type:     darcs   location: http://patch-tag.com/r/jmcarthur/fixed-point-  tag:      v0.3.0.0+  tag:      v0.4.0.0