{-# LANGUAGE CApiFFI, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
module Numeric.Fixed
( Fixed(..)
, fromFixed
, toFixed
) where
import Data.Bits
import Data.Coerce
import Data.Int
import Data.Ratio
import Data.Typeable
import Foreign.Storable
import Foreign.C.Types
newtype {-# CTYPE "signed int" #-} Fixed = Fixed { Fixed -> CInt
getFixed :: CInt } deriving (Fixed -> Fixed -> Bool
(Fixed -> Fixed -> Bool) -> (Fixed -> Fixed -> Bool) -> Eq Fixed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Fixed -> Fixed -> Bool
$c/= :: Fixed -> Fixed -> Bool
== :: Fixed -> Fixed -> Bool
$c== :: Fixed -> Fixed -> Bool
Eq,Eq Fixed
Eq Fixed
-> (Fixed -> Fixed -> Ordering)
-> (Fixed -> Fixed -> Bool)
-> (Fixed -> Fixed -> Bool)
-> (Fixed -> Fixed -> Bool)
-> (Fixed -> Fixed -> Bool)
-> (Fixed -> Fixed -> Fixed)
-> (Fixed -> Fixed -> Fixed)
-> Ord Fixed
Fixed -> Fixed -> Bool
Fixed -> Fixed -> Ordering
Fixed -> Fixed -> Fixed
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Fixed -> Fixed -> Fixed
$cmin :: Fixed -> Fixed -> Fixed
max :: Fixed -> Fixed -> Fixed
$cmax :: Fixed -> Fixed -> Fixed
>= :: Fixed -> Fixed -> Bool
$c>= :: Fixed -> Fixed -> Bool
> :: Fixed -> Fixed -> Bool
$c> :: Fixed -> Fixed -> Bool
<= :: Fixed -> Fixed -> Bool
$c<= :: Fixed -> Fixed -> Bool
< :: Fixed -> Fixed -> Bool
$c< :: Fixed -> Fixed -> Bool
compare :: Fixed -> Fixed -> Ordering
$ccompare :: Fixed -> Fixed -> Ordering
Ord,Typeable,Ptr Fixed -> IO Fixed
Ptr Fixed -> Int -> IO Fixed
Ptr Fixed -> Int -> Fixed -> IO ()
Ptr Fixed -> Fixed -> IO ()
Fixed -> Int
(Fixed -> Int)
-> (Fixed -> Int)
-> (Ptr Fixed -> Int -> IO Fixed)
-> (Ptr Fixed -> Int -> Fixed -> IO ())
-> (forall b. Ptr b -> Int -> IO Fixed)
-> (forall b. Ptr b -> Int -> Fixed -> IO ())
-> (Ptr Fixed -> IO Fixed)
-> (Ptr Fixed -> Fixed -> IO ())
-> Storable Fixed
forall b. Ptr b -> Int -> IO Fixed
forall b. Ptr b -> Int -> Fixed -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr Fixed -> Fixed -> IO ()
$cpoke :: Ptr Fixed -> Fixed -> IO ()
peek :: Ptr Fixed -> IO Fixed
$cpeek :: Ptr Fixed -> IO Fixed
pokeByteOff :: forall b. Ptr b -> Int -> Fixed -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> Fixed -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO Fixed
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Fixed
pokeElemOff :: Ptr Fixed -> Int -> Fixed -> IO ()
$cpokeElemOff :: Ptr Fixed -> Int -> Fixed -> IO ()
peekElemOff :: Ptr Fixed -> Int -> IO Fixed
$cpeekElemOff :: Ptr Fixed -> Int -> IO Fixed
alignment :: Fixed -> Int
$calignment :: Fixed -> Int
sizeOf :: Fixed -> Int
$csizeOf :: Fixed -> Int
Storable)
fromFixed :: Fixed -> Double
fromFixed :: Fixed -> Double
fromFixed (Fixed CInt
x) = CInt -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
65536
toFixed :: Double -> Fixed
toFixed :: Double -> Fixed
toFixed Double
x = CInt -> Fixed
Fixed (CInt -> Fixed) -> CInt -> Fixed
forall a b. (a -> b) -> a -> b
$ Double -> CInt
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
65536 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.5)
instance Show Fixed where
showsPrec :: Int -> Fixed -> ShowS
showsPrec Int
d = Int -> Double -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (Double -> ShowS) -> (Fixed -> Double) -> Fixed -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixed -> Double
fromFixed
instance Num Fixed where
+ :: Fixed -> Fixed -> Fixed
(+) = (CInt -> CInt -> CInt) -> Fixed -> Fixed -> Fixed
coerce (CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
(+) :: CInt -> CInt -> CInt)
(-) = (CInt -> CInt -> CInt) -> Fixed -> Fixed -> Fixed
coerce ((-) :: CInt -> CInt -> CInt)
negate :: Fixed -> Fixed
negate = (CInt -> CInt) -> Fixed -> Fixed
coerce (CInt -> CInt
forall a. Num a => a -> a
negate :: CInt -> CInt)
abs :: Fixed -> Fixed
abs = (CInt -> CInt) -> Fixed -> Fixed
coerce (CInt -> CInt
forall a. Num a => a -> a
abs :: CInt -> CInt)
signum :: Fixed -> Fixed
signum (Fixed CInt
a) = CInt -> Fixed
Fixed (CInt -> Fixed) -> CInt -> Fixed
forall a b. (a -> b) -> a -> b
$ CInt -> Int -> CInt
forall a. Bits a => a -> Int -> a
unsafeShiftL (CInt -> CInt
forall a. Num a => a -> a
signum CInt
a) Int
16
Fixed CInt
a * :: Fixed -> Fixed -> Fixed
* Fixed CInt
b = CInt -> Fixed
Fixed (CInt -> Fixed) -> CInt -> Fixed
forall a b. (a -> b) -> a -> b
$ Int64 -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
unsafeShiftR (CInt -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
a Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* CInt -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
b) Int
16 :: Int64)
fromInteger :: Integer -> Fixed
fromInteger Integer
i = CInt -> Fixed
Fixed (CInt -> Fixed) -> CInt -> Fixed
forall a b. (a -> b) -> a -> b
$ CInt -> Int -> CInt
forall a. Bits a => a -> Int -> a
unsafeShiftL (Integer -> CInt
forall a. Num a => Integer -> a
fromInteger Integer
i) Int
16
instance Enum Fixed where
succ :: Fixed -> Fixed
succ (Fixed CInt
a) = CInt -> Fixed
Fixed (CInt
a CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
+ CInt
0x10000)
pred :: Fixed -> Fixed
pred (Fixed CInt
a) = CInt -> Fixed
Fixed (CInt
a CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
0x10000)
fromEnum :: Fixed -> Int
fromEnum = Fixed -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate
toEnum :: Int -> Fixed
toEnum Int
a = CInt -> Fixed
Fixed (CInt -> Int -> CInt
forall a. Bits a => a -> Int -> a
unsafeShiftL (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a) Int
16)
enumFrom :: Fixed -> [Fixed]
enumFrom Fixed
a = Double -> Fixed
toFixed (Double -> Fixed) -> [Double] -> [Fixed]
forall a b. (a -> b) -> [a] -> [b]
`map` Double -> [Double]
forall a. Enum a => a -> [a]
enumFrom (Fixed -> Double
fromFixed Fixed
a)
enumFromTo :: Fixed -> Fixed -> [Fixed]
enumFromTo Fixed
a Fixed
b = Double -> Fixed
toFixed (Double -> Fixed) -> [Double] -> [Fixed]
forall a b. (a -> b) -> [a] -> [b]
`map` Double -> Double -> [Double]
forall a. Enum a => a -> a -> [a]
enumFromTo (Fixed -> Double
fromFixed Fixed
a) (Fixed -> Double
fromFixed Fixed
b)
enumFromThen :: Fixed -> Fixed -> [Fixed]
enumFromThen Fixed
a Fixed
b = Double -> Fixed
toFixed (Double -> Fixed) -> [Double] -> [Fixed]
forall a b. (a -> b) -> [a] -> [b]
`map` Double -> Double -> [Double]
forall a. Enum a => a -> a -> [a]
enumFromThen (Fixed -> Double
fromFixed Fixed
a) (Fixed -> Double
fromFixed Fixed
b)
enumFromThenTo :: Fixed -> Fixed -> Fixed -> [Fixed]
enumFromThenTo Fixed
a Fixed
b Fixed
c = Double -> Fixed
toFixed (Double -> Fixed) -> [Double] -> [Fixed]
forall a b. (a -> b) -> [a] -> [b]
`map` Double -> Double -> Double -> [Double]
forall a. Enum a => a -> a -> a -> [a]
enumFromThenTo (Fixed -> Double
fromFixed Fixed
a) (Fixed -> Double
fromFixed Fixed
b) (Fixed -> Double
fromFixed Fixed
c)
instance Bounded Fixed where
minBound :: Fixed
minBound = CInt -> Fixed
Fixed CInt
forall a. Bounded a => a
minBound
maxBound :: Fixed
maxBound = CInt -> Fixed
Fixed CInt
forall a. Bounded a => a
maxBound
instance Fractional Fixed where
Fixed CInt
a / :: Fixed -> Fixed -> Fixed
/ Fixed CInt
b = CInt -> Fixed
Fixed (CInt -> Fixed) -> CInt -> Fixed
forall a b. (a -> b) -> a -> b
$ Int64 -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
unsafeShiftL (CInt -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
a) Int
16 Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` CInt -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
b :: Int64)
fromRational :: Rational -> Fixed
fromRational Rational
a = CInt -> Fixed
Fixed (CInt -> Fixed) -> CInt -> Fixed
forall a b. (a -> b) -> a -> b
$ Integer -> CInt
forall a. Num a => Integer -> a
fromInteger (Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
unsafeShiftL (Rational -> Integer
forall a. Ratio a -> a
numerator Rational
a) Int
16 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Rational -> Integer
forall a. Ratio a -> a
denominator Rational
a)
instance Real Fixed where
toRational :: Fixed -> Rational
toRational (Fixed CInt
i) = CInt -> Integer
forall a. Integral a => a -> Integer
toInteger CInt
i Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
65536
instance RealFrac Fixed where
properFraction :: forall b. Integral b => Fixed -> (b, Fixed)
properFraction (Fixed CInt
a)
| CInt
a CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
>= CInt
0 = (CInt -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int -> CInt
forall a. Bits a => a -> Int -> a
unsafeShiftR CInt
a Int
16), CInt -> Fixed
Fixed (CInt
a CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.&. CInt
0xffff))
| Bool
otherwise = (b -> b
forall a. Num a => a -> a
negate (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ CInt -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> b) -> CInt -> b
forall a b. (a -> b) -> a -> b
$ CInt -> Int -> CInt
forall a. Bits a => a -> Int -> a
unsafeShiftR (CInt -> CInt
forall a. Num a => a -> a
negate CInt
a) Int
16, CInt -> Fixed
Fixed (CInt -> Fixed) -> CInt -> Fixed
forall a b. (a -> b) -> a -> b
$ (CInt
a CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.&. CInt
0xffff) CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
0x10000)
truncate :: forall b. Integral b => Fixed -> b
truncate (Fixed CInt
a)
| CInt
a CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
>= CInt
0 = CInt -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int -> CInt
forall a. Bits a => a -> Int -> a
unsafeShiftR CInt
a Int
16)
| Bool
otherwise = b -> b
forall a. Num a => a -> a
negate (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ CInt -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> b) -> CInt -> b
forall a b. (a -> b) -> a -> b
$ CInt -> Int -> CInt
forall a. Bits a => a -> Int -> a
unsafeShiftR (CInt -> CInt
forall a. Num a => a -> a
negate CInt
a) Int
16
round :: forall b. Integral b => Fixed -> b
round (Fixed CInt
f) = CInt -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> b) -> CInt -> b
forall a b. (a -> b) -> a -> b
$ CInt -> Int -> CInt
forall a. Bits a => a -> Int -> a
unsafeShiftR (CInt
f CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
+ CInt
0x8000) Int
16
ceiling :: forall b. Integral b => Fixed -> b
ceiling (Fixed CInt
f) = CInt -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> b) -> CInt -> b
forall a b. (a -> b) -> a -> b
$ CInt -> Int -> CInt
forall a. Bits a => a -> Int -> a
unsafeShiftR (CInt
f CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
+ CInt
0xffff) Int
16
floor :: forall b. Integral b => Fixed -> b
floor (Fixed CInt
f) = CInt -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> b) -> CInt -> b
forall a b. (a -> b) -> a -> b
$ CInt -> Int -> CInt
forall a. Bits a => a -> Int -> a
unsafeShiftR CInt
f Int
16
instance Floating Fixed where
pi :: Fixed
pi = Double -> Fixed
toFixed Double
forall a. Floating a => a
pi
exp :: Fixed -> Fixed
exp = Double -> Fixed
toFixed (Double -> Fixed) -> (Fixed -> Double) -> Fixed -> Fixed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a. Floating a => a -> a
exp (Double -> Double) -> (Fixed -> Double) -> Fixed -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixed -> Double
fromFixed
sqrt :: Fixed -> Fixed
sqrt = Double -> Fixed
toFixed (Double -> Fixed) -> (Fixed -> Double) -> Fixed -> Fixed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a. Floating a => a -> a
sqrt (Double -> Double) -> (Fixed -> Double) -> Fixed -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixed -> Double
fromFixed
log :: Fixed -> Fixed
log = Double -> Fixed
toFixed (Double -> Fixed) -> (Fixed -> Double) -> Fixed -> Fixed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a. Floating a => a -> a
log (Double -> Double) -> (Fixed -> Double) -> Fixed -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixed -> Double
fromFixed
Fixed
a ** :: Fixed -> Fixed -> Fixed
** Fixed
b = Double -> Fixed
toFixed (Double -> Fixed) -> Double -> Fixed
forall a b. (a -> b) -> a -> b
$ Fixed -> Double
fromFixed Fixed
a Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Fixed -> Double
fromFixed Fixed
b
logBase :: Fixed -> Fixed -> Fixed
logBase Fixed
a Fixed
b = Double -> Fixed
toFixed (Double -> Fixed) -> Double -> Fixed
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase (Fixed -> Double
fromFixed Fixed
a) (Fixed -> Double
fromFixed Fixed
b)
sin :: Fixed -> Fixed
sin = Double -> Fixed
toFixed (Double -> Fixed) -> (Fixed -> Double) -> Fixed -> Fixed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a. Floating a => a -> a
sin (Double -> Double) -> (Fixed -> Double) -> Fixed -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixed -> Double
fromFixed
tan :: Fixed -> Fixed
tan = Double -> Fixed
toFixed (Double -> Fixed) -> (Fixed -> Double) -> Fixed -> Fixed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a. Floating a => a -> a
tan (Double -> Double) -> (Fixed -> Double) -> Fixed -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixed -> Double
fromFixed
cos :: Fixed -> Fixed
cos = Double -> Fixed
toFixed (Double -> Fixed) -> (Fixed -> Double) -> Fixed -> Fixed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a. Floating a => a -> a
cos (Double -> Double) -> (Fixed -> Double) -> Fixed -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixed -> Double
fromFixed
asin :: Fixed -> Fixed
asin = Double -> Fixed
toFixed (Double -> Fixed) -> (Fixed -> Double) -> Fixed -> Fixed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a. Floating a => a -> a
asin (Double -> Double) -> (Fixed -> Double) -> Fixed -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixed -> Double
fromFixed
atan :: Fixed -> Fixed
atan = Double -> Fixed
toFixed (Double -> Fixed) -> (Fixed -> Double) -> Fixed -> Fixed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a. Floating a => a -> a
atan (Double -> Double) -> (Fixed -> Double) -> Fixed -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixed -> Double
fromFixed
acos :: Fixed -> Fixed
acos = Double -> Fixed
toFixed (Double -> Fixed) -> (Fixed -> Double) -> Fixed -> Fixed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a. Floating a => a -> a
acos (Double -> Double) -> (Fixed -> Double) -> Fixed -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixed -> Double
fromFixed
sinh :: Fixed -> Fixed
sinh = Double -> Fixed
toFixed (Double -> Fixed) -> (Fixed -> Double) -> Fixed -> Fixed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a. Floating a => a -> a
sinh (Double -> Double) -> (Fixed -> Double) -> Fixed -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixed -> Double
fromFixed
tanh :: Fixed -> Fixed
tanh = Double -> Fixed
toFixed (Double -> Fixed) -> (Fixed -> Double) -> Fixed -> Fixed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a. Floating a => a -> a
tanh (Double -> Double) -> (Fixed -> Double) -> Fixed -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixed -> Double
fromFixed
cosh :: Fixed -> Fixed
cosh = Double -> Fixed
toFixed (Double -> Fixed) -> (Fixed -> Double) -> Fixed -> Fixed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a. Floating a => a -> a
cosh (Double -> Double) -> (Fixed -> Double) -> Fixed -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixed -> Double
fromFixed
asinh :: Fixed -> Fixed
asinh = Double -> Fixed
toFixed (Double -> Fixed) -> (Fixed -> Double) -> Fixed -> Fixed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a. Floating a => a -> a
asinh (Double -> Double) -> (Fixed -> Double) -> Fixed -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixed -> Double
fromFixed
atanh :: Fixed -> Fixed
atanh = Double -> Fixed
toFixed (Double -> Fixed) -> (Fixed -> Double) -> Fixed -> Fixed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a. Floating a => a -> a
atanh (Double -> Double) -> (Fixed -> Double) -> Fixed -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixed -> Double
fromFixed
acosh :: Fixed -> Fixed
acosh = Double -> Fixed
toFixed (Double -> Fixed) -> (Fixed -> Double) -> Fixed -> Fixed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a. Floating a => a -> a
acosh (Double -> Double) -> (Fixed -> Double) -> Fixed -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixed -> Double
fromFixed
instance RealFloat Fixed where
floatRadix :: Fixed -> Integer
floatRadix Fixed
_ = Integer
2
floatDigits :: Fixed -> Int
floatDigits Fixed
_ = Int
16
decodeFloat :: Fixed -> (Integer, Int)
decodeFloat = Double -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat (Double -> (Integer, Int))
-> (Fixed -> Double) -> Fixed -> (Integer, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixed -> Double
fromFixed
isInfinite :: Fixed -> Bool
isInfinite Fixed
_ = Bool
False
isIEEE :: Fixed -> Bool
isIEEE Fixed
_ = Bool
False
atan2 :: Fixed -> Fixed -> Fixed
atan2 Fixed
a Fixed
b = Double -> Fixed
toFixed (Double -> Fixed) -> Double -> Fixed
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall a. RealFloat a => a -> a -> a
atan2 (Fixed -> Double
fromFixed Fixed
a) (Fixed -> Double
fromFixed Fixed
b)
isDenormalized :: Fixed -> Bool
isDenormalized (Fixed CInt
a) = CInt
a CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.&. CInt
0x7fff0000 CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
isNaN :: Fixed -> Bool
isNaN Fixed
_ = Bool
False
isNegativeZero :: Fixed -> Bool
isNegativeZero Fixed
_ = Bool
False
floatRange :: Fixed -> (Int, Int)
floatRange Fixed
_ = (Int
15,Int
0)
encodeFloat :: Integer -> Int -> Fixed
encodeFloat Integer
i Int
j = Double -> Fixed
toFixed (Double -> Fixed) -> Double -> Fixed
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Double
forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
i Int
j
exponent :: Fixed -> Int
exponent = Double -> Int
forall a. RealFloat a => a -> Int
exponent (Double -> Int) -> (Fixed -> Double) -> Fixed -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixed -> Double
fromFixed
significand :: Fixed -> Fixed
significand = Double -> Fixed
toFixed (Double -> Fixed) -> (Fixed -> Double) -> Fixed -> Fixed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a. RealFloat a => a -> a
significand (Double -> Double) -> (Fixed -> Double) -> Fixed -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixed -> Double
fromFixed
scaleFloat :: Int -> Fixed -> Fixed
scaleFloat Int
n (Fixed CInt
a) = CInt -> Fixed
Fixed (CInt -> Int -> CInt
forall a. Bits a => a -> Int -> a
shift CInt
a Int
n)