module Synthesizer.LLVM.Parameter where
import qualified LLVM.Core as LLVM
import qualified Algebra.Transcendental as Trans
import qualified Algebra.Algebraic as Algebraic
import qualified Algebra.Field as Field
import qualified Algebra.Ring as Ring
import qualified Algebra.Additive as Additive
import qualified Control.Category as Cat
import qualified Control.Arrow as Arr
import qualified Control.Applicative as App
import Control.Applicative (pure, liftA2, )
import Data.Tuple.HT (mapFst, )
import NumericPrelude.Numeric
import Prelude (fmap, error, (.), const, id, Functor, Monad, )
import qualified Prelude as P
data T p a =
Constant a |
Variable (p -> a)
get :: T p a -> (p -> a)
get (Constant a) = const a
get (Variable f) = f
value ::
LLVM.MakeValueTuple tuple value =>
T p tuple -> value -> value
value (Constant a) _ = LLVM.valueTupleOf a
value (Variable _) v = v
instance Cat.Category T where
id = Variable id
Constant f . _ = Constant f
Variable f . Constant a = Constant (f a)
Variable f . Variable g = Variable (f . g)
instance Arr.Arrow T where
arr = Variable
first f = Variable (mapFst (get f))
instance Functor (T p) where
fmap f (Constant a) = Constant (f a)
fmap f (Variable g) = Variable (f . g)
instance App.Applicative (T p) where
pure a = Constant a
Constant f <*> Constant a = Constant (f a)
f <*> a = Variable (\p -> get f p (get a p))
instance Monad (T p) where
return = pure
Constant x >>= f = f x
Variable x >>= f =
Variable (\p -> get (f (x p)) p)
instance Additive.C a => Additive.C (T p a) where
zero = pure zero
negate = fmap negate
(+) = liftA2 (+)
() = liftA2 ()
instance Ring.C a => Ring.C (T p a) where
one = pure one
(*) = liftA2 (*)
x^n = fmap (^n) x
fromInteger = pure . fromInteger
instance Field.C a => Field.C (T p a) where
(/) = liftA2 (/)
recip = fmap recip
fromRational' = pure . fromRational'
instance Algebraic.C a => Algebraic.C (T p a) where
x ^/ r = fmap (^/ r) x
sqrt = fmap sqrt
root n = fmap (Algebraic.root n)
instance Trans.C a => Trans.C (T p a) where
pi = pure pi
exp = fmap exp
log = fmap log
logBase = liftA2 logBase
(**) = liftA2 (**)
sin = fmap sin
tan = fmap tan
cos = fmap cos
asin = fmap asin
atan = fmap atan
acos = fmap acos
sinh = fmap sinh
tanh = fmap tanh
cosh = fmap cosh
asinh = fmap asinh
atanh = fmap atanh
acosh = fmap acosh
instance P.Eq a => P.Eq (T p a) where
(==) = error "Synthesizer.LLVM.Parameter: Num instance requires Eq but we cannot define that"
instance P.Show a => P.Show (T p a) where
show _ = "Synthesizer.LLVM.Parameter"
instance P.Num a => P.Num (T p a) where
(+) = liftA2 (P.+)
() = liftA2 (P.-)
(*) = liftA2 (P.*)
negate = fmap P.negate
abs = fmap P.abs
signum = fmap P.signum
fromInteger = pure . P.fromInteger
instance P.Fractional a => P.Fractional (T p a) where
(/) = liftA2 (P./)
fromRational = pure . P.fromRational