module Synthesizer.Basic.Phase (
T,
fromRepresentative,
toRepresentative,
increment,
decrement,
multiply,
) where
import qualified Algebra.ToInteger as ToInteger
import qualified Algebra.RealRing as RealRing
import qualified Algebra.Ring as Ring
import qualified Algebra.Additive as Additive
import System.Random (Random(..))
import Test.QuickCheck (Arbitrary(arbitrary), choose)
import Foreign.Storable (Storable(..), )
import Foreign.Ptr (castPtr, )
import Data.Tuple.HT (mapFst, )
import qualified NumericPrelude.Numeric as NP
import NumericPrelude.Numeric
import NumericPrelude.Base
import Prelude ()
import qualified GHC.Float as GHC
newtype T a = Cons {forall a. T a -> a
decons :: a}
deriving T a -> T a -> Bool
forall a. Eq a => T a -> T a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: T a -> T a -> Bool
$c/= :: forall a. Eq a => T a -> T a -> Bool
== :: T a -> T a -> Bool
$c== :: forall a. Eq a => T a -> T a -> Bool
Eq
instance Show a => Show (T a) where
showsPrec :: Int -> T a -> ShowS
showsPrec Int
p T a
x =
Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
>= Int
10)
(String -> ShowS
showString String
"Phase.fromRepresentative " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 (forall a. T a -> a
toRepresentative T a
x))
instance Storable a => Storable (T a) where
{-# INLINE sizeOf #-}
sizeOf :: T a -> Int
sizeOf = forall a. Storable a => a -> Int
sizeOf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. T a -> a
toRepresentative
{-# INLINE alignment #-}
alignment :: T a -> Int
alignment = forall a. Storable a => a -> Int
alignment forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. T a -> a
toRepresentative
{-# INLINE peek #-}
peek :: Ptr (T a) -> IO (T a)
peek Ptr (T a)
ptr = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> T a
Cons forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr (T a)
ptr)
{-# INLINE poke #-}
poke :: Ptr (T a) -> T a -> IO ()
poke Ptr (T a)
ptr = forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr (T a)
ptr) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. T a -> a
toRepresentative
instance (Ring.C a, Random a) => Random (T a) where
randomR :: forall g. RandomGen g => (T a, T a) -> g -> (T a, g)
randomR = forall a. HasCallStack => String -> a
error String
"Phase.randomR makes no sense"
random :: forall g. RandomGen g => g -> (T a, g)
random = forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst forall a. a -> T a
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (forall a. C a => a
zero, forall a. C a => a
one)
instance (Ring.C a, Random a) => Arbitrary (T a) where
arbitrary :: Gen (T a)
arbitrary = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> T a
Cons forall a b. (a -> b) -> a -> b
$ forall a. Random a => (a, a) -> Gen a
choose (forall a. C a => a
zero, forall a. C a => a
one)
{-# INLINE fromRepresentative #-}
fromRepresentative :: RealRing.C a => a -> T a
fromRepresentative :: forall a. C a => a -> T a
fromRepresentative = forall a. a -> T a
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. C a => a -> a
RealRing.fraction
{-# INLINE toRepresentative #-}
toRepresentative :: T a -> a
toRepresentative :: forall a. T a -> a
toRepresentative = forall a. T a -> a
decons
{-# INLINE increment #-}
increment :: RealRing.C a => a -> T a -> T a
increment :: forall a. C a => a -> T a -> T a
increment a
d = forall b a. C b => (a -> b) -> T a -> T b
lift (a
d forall a. C a => a -> a -> a
Additive.+)
{-# INLINE decrement #-}
decrement :: RealRing.C a => a -> T a -> T a
decrement :: forall a. C a => a -> T a -> T a
decrement a
d = forall b a. C b => (a -> b) -> T a -> T b
lift (forall a. C a => a -> a -> a
Additive.subtract a
d)
{-# INLINE add #-}
add :: (Ring.C a, Ord a) => T a -> T a -> T a
add :: forall a. (C a, Ord a) => T a -> T a -> T a
add (Cons a
x) (Cons a
y) =
let z :: a
z = a
xforall a. C a => a -> a -> a
+a
y
in forall a. a -> T a
Cons forall a b. (a -> b) -> a -> b
$ if a
zforall a. Ord a => a -> a -> Bool
>=forall a. C a => a
one then a
zforall a. C a => a -> a -> a
-forall a. C a => a
one else a
z
{-# INLINE sub #-}
sub :: (Ring.C a, Ord a) => T a -> T a -> T a
sub :: forall a. (C a, Ord a) => T a -> T a -> T a
sub (Cons a
x) (Cons a
y) =
let z :: a
z = a
xforall a. C a => a -> a -> a
-a
y
in forall a. a -> T a
Cons forall a b. (a -> b) -> a -> b
$ if a
zforall a. Ord a => a -> a -> Bool
<forall a. C a => a
zero then a
zforall a. C a => a -> a -> a
+forall a. C a => a
one else a
z
{-# INLINE neg #-}
neg :: (Ring.C a, Ord a) => T a -> T a
neg :: forall a. (C a, Ord a) => T a -> T a
neg (Cons a
x) =
forall a. a -> T a
Cons forall a b. (a -> b) -> a -> b
$ if a
xforall a. Eq a => a -> a -> Bool
==forall a. C a => a
zero then forall a. C a => a
zero else forall a. C a => a
oneforall a. C a => a -> a -> a
-a
x
{-# INLINE multiply #-}
multiply :: (RealRing.C a, ToInteger.C b) => b -> T a -> T a
multiply :: forall a b. (C a, C b) => b -> T a -> T a
multiply b
n = forall b a. C b => (a -> b) -> T a -> T b
lift (forall a b. (C a, C b) => a -> b
NP.fromIntegral b
n forall a. C a => a -> a -> a
Ring.*)
instance RealRing.C a => Additive.C (T a) where
{-# INLINE zero #-}
{-# INLINE (+) #-}
{-# INLINE (-) #-}
{-# INLINE negate #-}
zero :: T a
zero = forall a. a -> T a
Cons forall a. C a => a
Additive.zero
+ :: T a -> T a -> T a
(+) = forall a. (C a, Ord a) => T a -> T a -> T a
add
(-) = forall a. (C a, Ord a) => T a -> T a -> T a
sub
negate :: T a -> T a
negate = forall a. (C a, Ord a) => T a -> T a
neg
{-# INLINE lift #-}
lift :: (RealRing.C b) =>
(a -> b) -> T a -> T b
lift :: forall b a. C b => (a -> b) -> T a -> T b
lift a -> b
f =
forall a. C a => a -> T a
fromRepresentative forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. T a -> a
toRepresentative
{-# INLINE customFromRepresentative #-}
customFromRepresentative ::
(Additive.C a) =>
(a -> i) -> (i -> a) -> a -> T a
customFromRepresentative :: forall a i. C a => (a -> i) -> (i -> a) -> a -> T a
customFromRepresentative a -> i
toInt i -> a
fromInt a
x =
forall a. a -> T a
Cons (a
x forall a. C a => a -> a -> a
Additive.- i -> a
fromInt (a -> i
toInt a
x))
{-# INLINE customLift #-}
customLift ::
(Additive.C b) =>
(b -> i) -> (i -> b) ->
(a -> b) -> T a -> T b
customLift :: forall b i a. C b => (b -> i) -> (i -> b) -> (a -> b) -> T a -> T b
customLift b -> i
toInt i -> b
fromInt a -> b
f =
forall a i. C a => (a -> i) -> (i -> a) -> a -> T a
customFromRepresentative b -> i
toInt i -> b
fromInt forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. T a -> a
toRepresentative
{-# INLINE customMultiply #-}
customMultiply ::
(Ring.C a, Ord a, ToInteger.C b) =>
(a -> i) -> (i -> a) ->
b -> T a -> T a
customMultiply :: forall a b i.
(C a, Ord a, C b) =>
(a -> i) -> (i -> a) -> b -> T a -> T a
customMultiply a -> i
toInt i -> a
fromInt b
n (Cons a
x) =
forall a i. C a => (a -> i) -> (i -> a) -> a -> T a
customFromRepresentative a -> i
toInt i -> a
fromInt forall a b. (a -> b) -> a -> b
$
if b
nforall a. Ord a => a -> a -> Bool
<forall a. C a => a
zero Bool -> Bool -> Bool
&& a
xforall a. Ord a => a -> a -> Bool
>forall a. C a => a
zero
then (forall a. C a => a
oneforall a. C a => a -> a -> a
-a
x) forall a. C a => a -> a -> a
* forall a b. (C a, C b) => a -> b
NP.fromIntegral (forall a. C a => a -> a
NP.negate b
n)
else a
x forall a. C a => a -> a -> a
* forall a b. (C a, C b) => a -> b
NP.fromIntegral b
n
{-# RULES
"Phase.multiply @ Float" multiply = customMultiply GHC.float2Int GHC.int2Float;
"Phase.multiply @ Double" multiply = customMultiply GHC.double2Int GHC.int2Double;
"Phase.increment @ Float" increment = \d -> customLift GHC.float2Int GHC.int2Float (+d);
"Phase.increment @ Double" increment = \d -> customLift GHC.double2Int GHC.int2Double (+d);
"Phase.decrement @ Float" decrement = \d -> customLift GHC.float2Int GHC.int2Float (subtract d);
"Phase.decrement @ Double" decrement = \d -> customLift GHC.double2Int GHC.int2Double (subtract d);
#-}