module Synthesizer.Basic.Phase
(T,
fromRepresentative,
toRepresentative,
increment,
decrement,
multiply,
) where
import qualified Algebra.RealField as RealField
import qualified Algebra.Ring as Ring
import qualified Algebra.Additive as Additive
import qualified Algebra.ToInteger as ToInteger
import System.Random (Random(..))
import Test.QuickCheck (Arbitrary(..), choose)
import Foreign.Storable (Storable(..), )
import Foreign.Ptr (castPtr, )
import Data.Tuple.HT (mapFst, )
import qualified NumericPrelude as NP
newtype T a = Cons {decons :: a}
deriving Eq
instance Show a => Show (T a) where
showsPrec p x =
showParen (p >= 10)
(showString "Phase.fromRepresentative " . showsPrec 11 (toRepresentative x))
instance Storable a => Storable (T a) where
sizeOf = sizeOf . toRepresentative
alignment = alignment . toRepresentative
peek ptr = fmap Cons $ peek (castPtr ptr)
poke ptr = poke (castPtr ptr) . toRepresentative
instance (Ring.C a, Random a) => Random (T a) where
randomR = error "Phase.randomR makes no sense"
random = mapFst Cons . randomR (NP.zero, NP.one)
instance (Ring.C a, Random a) => Arbitrary (T a) where
arbitrary = fmap Cons $ choose (NP.zero, NP.one)
coarbitrary = error "Phase.coarbitrary not implemented"
fromRepresentative :: RealField.C a => a -> T a
fromRepresentative = Cons . RealField.fraction
toRepresentative :: T a -> a
toRepresentative = decons
increment :: RealField.C a => a -> T a -> T a
increment d = lift (d Additive.+)
decrement :: RealField.C a => a -> T a -> T a
decrement d = lift (Additive.subtract d)
multiply :: (RealField.C a, ToInteger.C b) => b -> T a -> T a
multiply n x = fromRepresentative (toRepresentative x Ring.* NP.fromIntegral n)
instance RealField.C a => Additive.C (T a) where
zero = Cons Additive.zero
x + y = fromRepresentative (toRepresentative x Additive.+ toRepresentative y)
x y = fromRepresentative (toRepresentative x Additive.- toRepresentative y)
negate = lift Additive.negate
lift :: RealField.C a => (a -> a) -> T a -> T a
lift f =
fromRepresentative . f . toRepresentative