fixed-point 0.2.0.0 → 0.3.0.0

raw patch · 2 files changed

+207/−36 lines, 2 filesdep +vectorPVP ok

version bump matches the API change (PVP)

Dependencies added: vector

API changes (from Hackage documentation)

Files

• Data/Fixed/Binary.hs +178/−25
• fixed-point.cabal +29/−11

@@ -1,8 +1,12 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}+{-# LANGUAGE ViewPatterns #-}  {-| This module defines a type for binary fixed-point arithmetic. The main@@ -10,18 +14,18 @@ the point is maintained using fast bit shifts instead of slow 'div' operations. This type is also polymorphic on the underlying representation, so you can use whatever size and signedness you-want. You just have to be mindful of overflows if you use a fixed-size-representation, especially with operations like multiplication.+want. -} module Data.Fixed.Binary        ( div'        , mod'        , divMod'        , Fixed ()+       , SuperTypeable (..)        , HasResolution (..)        , E0, E1, E2, E4, E8, E10, E16, E20, E30, E32, E64        , S, P-       , fixedRadix, fixedSize+       , fixedRadix, fixedSize, fromRealFloat        , (:+), (*.)        , (:-), (/.)        ) where@@ -31,8 +35,9 @@ import Control.Monad import Data.Bits import Data.Fixed (div', mod', divMod')-import Data.List+import Data.Function import Data.Int+import Data.List import Data.Maybe import Data.Ratio import Data.Typeable@@ -40,6 +45,10 @@ import Text.Read import qualified Text.Read.Lex as L +import qualified Data.Vector.Generic as VG+import qualified Data.Vector.Generic.Mutable as VGM+import qualified Data.Vector.Unboxed as VU+ -- | The first type parameter represents the number of bits to devote -- to the fractional part of the number. The second type parameter is -- the underlying representation. For example, @Fixed E8 Int16@ uses@@ -48,6 +57,51 @@ newtype Fixed r a = Fixed { unFixed :: a }                   deriving (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 }++instance VGM.MVector VU.MVector a => VGM.MVector VU.MVector (Fixed r a) where+  {-# INLINE basicLength #-}+  basicLength                     = VGM.basicLength . unMVFixed+  {-# INLINE basicUnsafeSlice #-}+  basicUnsafeSlice i n            = MVFixed . VGM.basicUnsafeSlice i n . unMVFixed+  {-# INLINE basicOverlaps #-}+  basicOverlaps                   = VGM.basicOverlaps `on` unMVFixed+  {-# INLINE basicUnsafeNew #-}+  basicUnsafeNew                  = liftM MVFixed . VGM.basicUnsafeNew+  {-# INLINE basicUnsafeReplicate #-}+  basicUnsafeReplicate n          = liftM MVFixed . VGM.basicUnsafeReplicate n . unFixed+  {-# INLINE basicUnsafeRead #-}+  basicUnsafeRead (MVFixed mv)    = liftM Fixed . VGM.basicUnsafeRead mv+  {-# INLINE basicUnsafeWrite #-}+  basicUnsafeWrite (MVFixed mv) i = VGM.basicUnsafeWrite mv i . unFixed+  {-# INLINE basicClear #-}+  basicClear                      = VGM.basicClear . unMVFixed+  {-# INLINE basicSet #-}+  basicSet (MVFixed mv)           = VGM.basicSet mv . unFixed+  {-# INLINE basicUnsafeCopy #-}+  basicUnsafeCopy                 = VGM.basicUnsafeCopy `on` unMVFixed+  {-# INLINE basicUnsafeGrow #-}+  basicUnsafeGrow (MVFixed mv)    = liftM MVFixed . VGM.basicUnsafeGrow mv++instance VG.Vector VU.Vector a => VG.Vector VU.Vector (Fixed r a) where+  {-# INLINE basicUnsafeFreeze #-}+  basicUnsafeFreeze            = liftM VFixed . VG.basicUnsafeFreeze . unMVFixed+  {-# INLINE basicUnsafeThaw #-}+  basicUnsafeThaw              = liftM MVFixed . VG.basicUnsafeThaw . unVFixed+  {-# INLINE basicLength #-}+  basicLength                  = VG.basicLength . unVFixed+  {-# INLINE basicUnsafeSlice #-}+  basicUnsafeSlice i n         = VFixed . VG.basicUnsafeSlice i n . unVFixed+  {-# INLINE basicUnsafeIndexM #-}+  basicUnsafeIndexM (VFixed v) = liftM Fixed . VG.basicUnsafeIndexM v+  {-# INLINE basicUnsafeCopy #-}+  basicUnsafeCopy (MVFixed mv) = VG.basicUnsafeCopy mv . unVFixed+  {-# INLINE elemseq #-}+  elemseq (VFixed v)           = VG.elemseq v . unFixed++instance VU.Unbox a => VU.Unbox (Fixed r a)+ inFixed :: (a -> b) -> (Fixed r a -> Fixed s b) {-# INLINE inFixed #-} inFixed = (Fixed .) . (. unFixed)@@ -82,29 +136,33 @@          _   -> convert x   ) --- Stolden from GHC.Read.+-- Stolen from GHC.Read. convertFrac :: Fractional a => L.Lexeme -> ReadPrec a convertFrac (L.Int i) = return (fromInteger i) convertFrac (L.Rat r) = return (fromRational r) convertFrac _         = pfail -instance (HasResolution r, Bits a, Integral a) => Read (Fixed r a) where+instance ( HasResolution r, Bits a, Bits (Super a), Integral a+         , Integral (Super a), SuperTypeable a) => Read (Fixed r a) where   readPrec = readNumber convertFrac -instance (HasResolution r, Bits a, Integral a) => Show (Fixed r a) where-  show = reverse . uncurry (++) . second ('.':) .-         join (***) (\str -> if null str then "0" else str) . uncurry splitAt .-         second (reverse . show . numerator) . fromJust .-         find ((==1) . denominator . snd) . iterate (succ *** (*10)) . (,) 0 .-         toRational+instance ( HasResolution r, Bits a, Bits (Super a), Integral a+         , Integral (Super a), SuperTypeable a) => Show (Fixed r a) where+  show (properFraction -> (i, f)) =+    show (i :: Integer) ++ "." ++ (uncurry pad . second (show . numerator) .+                                   fromJust . find ((==1) . denominator . snd) .+                                   iterate (succ *** (*10)) . (,) 0 $+                                   toRational f)+    where pad n str = replicate (n - length str) '0' ++ str -instance (HasResolution r, Bits a, Integral a) => Num (Fixed r a) where+instance ( HasResolution r, Bits a, Bits (Super a), Integral a, Num (Super a)+         , Integral (Super a), SuperTypeable a) => Num (Fixed r a) where   {-# INLINABLE (+) #-}   (+) = inFixed2 (+)   {-# INLINABLE (-) #-}   (-) = inFixed2 (-)   {-# INLINABLE (*) #-}-  Fixed x * Fixed y = withResolution $ Fixed . shiftR (x*y)+  Fixed x * Fixed y = withResolution $ Fixed . subCast . shiftR (superCast x * superCast y)   {-# INLINABLE negate #-}   negate = inFixed negate   {-# INLINABLE abs #-}@@ -114,20 +172,24 @@   {-# INLINABLE fromInteger #-}   fromInteger i = withResolution $ Fixed . shiftL (fromInteger i) -instance (HasResolution r, Bits a, Integral a) => Real (Fixed r a) where+instance ( HasResolution r, Bits a, Bits (Super a), Integral a+         , Integral (Super a), SuperTypeable a) => Real (Fixed r a) where   {-# INLINABLE toRational #-}   toRational x = toRational (unFixed x) / toRational (2 ^ resolution x :: Integer) -instance (HasResolution r, Bits a, Integral a) => Fractional (Fixed r a) where+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 $ (unFixed a `shiftL` resolution a) `div` unFixed b+  a / b = Fixed . subCast $ (superCast (unFixed a) `shiftL` resolution a) `div` superCast (unFixed b)   {-# INLINABLE recip #-}-  recip x = Fixed $ (1 `shiftL` (2 * resolution x)) `div` unFixed x+  recip x = Fixed . subCast $ (1 `shiftL` (2 * resolution x)) `div` superCast (unFixed x)   {-# INLINABLE fromRational #-}   fromRational r = withResolution $ \s ->     Fixed . floor $ (numerator r `shiftL` s) % denominator r -instance (HasResolution r, Bits a, Integral a) => RealFrac (Fixed r a) where+instance ( HasResolution r, Bits a, Bits (Super a), Integral a+         , Integral (Super a), SuperTypeable a) => RealFrac (Fixed r a) where   {-# INLINABLE properFraction #-}   properFraction a = let i = truncate a in (i, a - fromIntegral i)   {-# INLINABLE truncate #-}@@ -167,13 +229,10 @@ fixedSize x = withResolution $ \s -> Fixed $ unFixed x `shift` (s - resolution x) -- TODO Rewrite rules? --- | Multiplication without throwing away fractional information. Note--- that this doesn't help against losing significant information from--- the integer component. If you are concerned about preventing--- overflow then convert to a larger representation first.-(*.) :: Num a => Fixed r a -> Fixed s a -> Fixed (r :+ s) a+-- | Multiplication without throwing away fractional information.+(*.) :: (Num (Super a), SuperTypeable a) => Fixed r a -> Fixed s a -> Fixed (r :+ s) a {-# INLINABLE (*.) #-}-(*.) = inFixed2 (*)+(*.) = inFixed2 ((fmap subCast . (*)) `on` superCast)  -- | Division without throwing away fractional information. Same -- caveats apply as with '(*.)'.@@ -194,6 +253,19 @@ "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 #-}+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 #-}+{-# SPECIALIZE fromRealFloat :: (HasResolution r, Num b) => Double -> Fixed r b #-}+-- TODO Rewrite rules?++shiftBaseExp :: Integer -> Integer -> Int -> Integer+shiftBaseExp x b e | e < 0     = x `div` (b ^ negate e)+                   | otherwise = x * (b ^ e)+ data E0  -- | Increment a resolution@@ -235,3 +307,84 @@ instance HasResolution E0 where   {-# INLINE resolution #-}   resolution = const 0++-- | Instances of 'SuperTypeable' can be cast up to and down from a+-- supertype. If the type is bounded, the supertype must be able to+-- hold at least twice as much information to be a valid instance.+class SuperTypeable a where+  type Super a+  +  -- | Losslessly cast to a supertype.+  superCast :: a -> Super a+  +  -- | Cast to a subtype. Information may be lost.+  subCast :: Super a -> a++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)+  superCast = fixedRadix+  subCast = fixedRadix++instance SuperTypeable Word8 where+  type Super Word8 = Word16+  superCast = fromIntegral+  subCast = fromIntegral++instance SuperTypeable Word16 where+  type Super Word16 = Word32+  superCast = fromIntegral+  subCast = fromIntegral++instance SuperTypeable Word32 where+  type Super Word32 = Word64+  superCast = fromIntegral+  subCast = fromIntegral++instance SuperTypeable Word64 where+  type Super Word64 = Integer+  superCast = fromIntegral+  subCast = fromIntegral++instance SuperTypeable Word where+#ifdef i386_HOST_ARCH+  type Super Word = Word64+#else+  type Super Word = Integer+#endif+  superCast = fromIntegral+  subCast = fromIntegral++instance SuperTypeable Int8 where+  type Super Int8 = Int16+  superCast = fromIntegral+  subCast = fromIntegral++instance SuperTypeable Int16 where+  type Super Int16 = Int32+  superCast = fromIntegral+  subCast = fromIntegral++instance SuperTypeable Int32 where+  type Super Int32 = Int64+  superCast = fromIntegral+  subCast = fromIntegral++instance SuperTypeable Int64 where+  type Super Int64 = Integer+  superCast = fromIntegral+  subCast = fromIntegral++instance SuperTypeable Int where+#ifdef i386_HOST_ARCH+  type Super Int = Int64+#else+  type Super Int = Integer+#endif+  superCast = fromIntegral+  subCast = fromIntegral++instance SuperTypeable Integer where+  type Super Integer = Integer+  superCast = id+  subCast = id

@@ -1,28 +1,46 @@ Name:                fixed-point-Version:             0.2.0.0+Version:             0.3.0.0 Synopsis:            Binary fixed-point arithmetic Description:         This package defines a type for binary-                     fixed-precision arithmetic. Its interface is-                     intended to be almost the same as the one-                     provided by Data.Fixed. The main differences are-                     that this is binary fixed-point and it's-                     polymorphic in the underlying representation.+                     fixed-precision arithmetic. The main differences+                     between this and Data.Fixed are that this is+                     binary fixed-point and it's polymorphic in the+                     underlying representation.++                     When is this more appropriate than floating+                     point? You'll mainly want to use this when you+                     need to be able to represent fractional values+                     within a bounded range. Fixed-point numbers have+                     the advantage of uniformity in these cases. On+                     the downside, you lose precision relative to+                     floating point numbers as you approach zero, and+                     you lose the ability to express very large (but+                     imprecise) values that floating point can+                     express. On some architectures, fixed-point+                     arithmetic might be faster than floating-point+                     arithmetic, but this is probably not the case on+                     x86. License:             MIT License-file:        LICENSE Author:              Jake McArthur Maintainer:          Jake McArthur <Jake.McArthur@gmail.com>-Category:            Data+Category:            Data, Game, Math, Numerical Build-type:          Simple Cabal-version:       >=1.6  Library-  Build-depends:       base == 4.3.*+  Build-depends:       base == 4.3.*,+                       vector == 0.7.*   Exposed-modules:     Data.Fixed.Binary-  Extensions:          DeriveDataTypeable,+  Extensions:          CPP,+                       DeriveDataTypeable,                        EmptyDataDecls,+                       FlexibleContexts,                        GeneralizedNewtypeDeriving,+                       MultiParamTypeClasses,                        TypeFamilies,-                       TypeOperators+                       TypeOperators,+                       ViewPatterns   GHC-options:         -Wall -fwarn-tabs -funfolding-use-threshold=16  Source-repository head@@ -32,4 +50,4 @@ source-repository this   type:     darcs   location: http://patch-tag.com/r/jmcarthur/fixed-point-  tag:      v0.2.0.0+  tag:      v0.3.0.0