{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Haskus.Format.Binary.FixedPoint
( FixedPoint
, toFixedPoint
, fromFixedPoint
)
where
import Haskus.Format.Binary.BitField
import Haskus.Format.Binary.Bits
import Haskus.Format.Binary.Storable
import Haskus.Utils.Types
newtype FixedPoint w (i :: Nat) (f :: Nat) = FixedPoint (BitFields w
'[ BitField i "integer" w
, BitField f "fractional" w
])
deriving (Storable)
deriving instance forall w n d.
( Integral w
, Bits w
, Field w
, BitSize w ~ (n + d)
, KnownNat n
, KnownNat d
) => Eq (FixedPoint w n d)
deriving instance forall w n d.
( Integral w
, Bits w
, Field w
, BitSize w ~ (n + d)
, KnownNat n
, KnownNat d
, Show w
) => Show (FixedPoint w n d)
toFixedPoint :: forall a w (n :: Nat) (d :: Nat).
( RealFrac a
, BitSize w ~ (n + d)
, KnownNat n
, KnownNat d
, Bits w
, Field w
, Num w
, Integral w
) => a -> FixedPoint w n d
toFixedPoint a = FixedPoint $ BitFields (round (a * 2^natValue' @d))
fromFixedPoint :: forall a w (n :: Nat) (d :: Nat).
( RealFrac a
, BitSize w ~ (n + d)
, KnownNat n
, KnownNat d
, Bits w
, Field w
, Num w
, Integral w
) => FixedPoint w n d -> a
fromFixedPoint (FixedPoint bf) = w / 2^(natValue' @d)
where
w = fromIntegral (bitFieldsBits bf)