{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
{- |
Wrap LLVM code for arithmetic computations.
Similar to "LLVM.DSL.Expression" but not based on 'MultiValue'
but on "LLVM.Extra.Arithmetic" methods.
Detects sharing using a 'Vault'.
-}
module LLVM.DSL.Value (
   T, decons,
   tau, square, sqrt,
   max, min, limit, fraction,

   (%==), (%/=), (%<), (%<=), (%>), (%>=), not,
   (%&&), (%||),
   (?), (??),

   lift0, lift1, lift2, lift3,
   unlift0, unlift1, unlift2, unlift3, unlift4, unlift5,
   constantValue, constant,
   fromInteger', fromRational',

   Flatten(flattenCode, unfoldCode), Registers,
   flatten, unfold,
   flattenCodeTraversable, unfoldCodeTraversable,
   flattenFunction,
   ) where

import qualified LLVM.Extra.Control as C
import qualified LLVM.Extra.Arithmetic as A
import qualified LLVM.Extra.Tuple as Tuple

import qualified LLVM.Core as LLVM

import qualified Data.Vault.Lazy as Vault
import qualified Control.Monad.Trans.Class as MT
import qualified Control.Monad.Trans.State as MS
import Control.Monad (liftM2, liftM3)
import Control.Applicative (Applicative, pure, (<*>))
import Control.Functor.HT (unzip, unzip3)

-- import qualified Algebra.NormedSpace.Maximum   as NormedMax
import qualified Algebra.NormedSpace.Euclidean as NormedEuc
import qualified Algebra.NormedSpace.Sum       as NormedSum

import qualified Algebra.Transcendental as Trans
import qualified Algebra.Algebraic as Algebraic
import qualified Algebra.Absolute as Absolute
import qualified Algebra.Module as Module
import qualified Algebra.Field as Field
import qualified Algebra.Ring as Ring
import qualified Algebra.Additive as Additive

import qualified Number.Complex as Complex

import qualified Data.Traversable as Trav
import qualified Data.Foldable as Fold

import qualified System.Unsafe as Unsafe

import qualified Prelude as P
import NumericPrelude.Numeric hiding (pi, sqrt, fromRational', fraction)
import NumericPrelude.Base hiding (min, max, unzip, unzip3, not)


{-
The @r@ type parameter must be hidden and forall-quantified
because otherwise we would need an impossible type
where we have to quantify for @r@ and @t@ in different scopes
while having a class constraint that involves both of them.

> osci ::
>    (RealRing.C (Value.T r t),
>     IsFirstClass t, IsFloating t,
>     IsPrimitive t, IsConst t) =>
>    (forall r. Wave.T (Value.T r t) (Value.T r y)) ->
>    t -> t -> T (Value y)

-}
newtype T a = Cons {forall a. T a -> forall r. Compute r a
code :: forall r. Compute r a}

decons :: T a -> (forall r. LLVM.CodeGenFunction r a)
decons :: forall a. T a -> forall r. CodeGenFunction r a
decons T a
value =
   StateT Vault (CodeGenFunction r) a -> Vault -> CodeGenFunction r a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
MS.evalStateT (T a -> forall r. Compute r a
forall a. T a -> forall r. Compute r a
code T a
value) Vault
Vault.empty

instance Functor T where
   fmap :: forall a b. (a -> b) -> T a -> T b
fmap a -> b
f T a
x = (forall r. Compute r b) -> T b
forall a. (forall r. Compute r a) -> T a
consUnique ((a -> b)
-> StateT Vault (CodeGenFunction r) a
-> StateT Vault (CodeGenFunction r) b
forall a b.
(a -> b)
-> StateT Vault (CodeGenFunction r) a
-> StateT Vault (CodeGenFunction r) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (T a -> forall r. Compute r a
forall a. T a -> forall r. Compute r a
code T a
x))

instance Applicative T where
   pure :: forall a. a -> T a
pure = a -> T a
forall a. a -> T a
constantValue
   T (a -> b)
f <*> :: forall a b. T (a -> b) -> T a -> T b
<*> T a
x = (forall r. Compute r b) -> T b
forall a. (forall r. Compute r a) -> T a
consUnique (T (a -> b) -> forall r. Compute r (a -> b)
forall a. T a -> forall r. Compute r a
code T (a -> b)
f Compute r (a -> b)
-> StateT Vault (CodeGenFunction r) a
-> StateT Vault (CodeGenFunction r) b
forall a b.
StateT Vault (CodeGenFunction r) (a -> b)
-> StateT Vault (CodeGenFunction r) a
-> StateT Vault (CodeGenFunction r) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> T a -> forall r. Compute r a
forall a. T a -> forall r. Compute r a
code T a
x)


type Compute r a =
   MS.StateT Vault.Vault (LLVM.CodeGenFunction r) a

consUnique :: (forall r. Compute r a) -> T a
consUnique :: forall a. (forall r. Compute r a) -> T a
consUnique forall r. Compute r a
code0 =
   IO (T a) -> T a
forall a. IO a -> a
Unsafe.performIO (IO (T a) -> T a) -> IO (T a) -> T a
forall a b. (a -> b) -> a -> b
$
   (Key a -> T a) -> IO (Key a) -> IO (T a)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall r. Compute r a) -> Key a -> T a
forall a. (forall r. Compute r a) -> Key a -> T a
consKey Compute r a
forall r. Compute r a
code0) IO (Key a)
forall a. IO (Key a)
Vault.newKey

consKey :: (forall r. Compute r a) -> Vault.Key a -> T a
consKey :: forall a. (forall r. Compute r a) -> Key a -> T a
consKey forall r. Compute r a
code0 Key a
key =
   (forall r. Compute r a) -> T a
forall a. (forall r. Compute r a) -> T a
Cons (do
      Maybe a
ma <- (Vault -> Maybe a) -> StateT Vault (CodeGenFunction r) (Maybe a)
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
MS.gets (Key a -> Vault -> Maybe a
forall a. Key a -> Vault -> Maybe a
Vault.lookup Key a
key)
      case Maybe a
ma of
         Just a
a -> a -> Compute r a
forall a. a -> StateT Vault (CodeGenFunction r) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
         Maybe a
Nothing -> do
            a
a <- Compute r a
forall r. Compute r a
code0
            (Vault -> Vault) -> StateT Vault (CodeGenFunction r) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
MS.modify (Key a -> a -> Vault -> Vault
forall a. Key a -> a -> Vault -> Vault
Vault.insert Key a
key a
a)
            a -> Compute r a
forall a. a -> StateT Vault (CodeGenFunction r) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a)

{- |
We do not require a numeric prelude superclass,
thus also LLVM only types like vectors are instances.
-}
instance (A.Additive a) => Additive.C (T a) where
   zero :: T a
zero = a -> T a
forall a. a -> T a
constantValue a
forall a. Additive a => a
A.zero
   + :: T a -> T a -> T a
(+) = (forall r. a -> a -> CodeGenFunction r a) -> T a -> T a -> T a
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T a -> T b -> T c
lift2 a -> a -> CodeGenFunction r a
forall r. a -> a -> CodeGenFunction r a
forall a r. Additive a => a -> a -> CodeGenFunction r a
A.add
   (-) = (forall r. a -> a -> CodeGenFunction r a) -> T a -> T a -> T a
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T a -> T b -> T c
lift2 a -> a -> CodeGenFunction r a
forall r. a -> a -> CodeGenFunction r a
forall a r. Additive a => a -> a -> CodeGenFunction r a
A.sub
   negate :: T a -> T a
negate = (forall r. a -> CodeGenFunction r a) -> T a -> T a
forall a b. (forall r. a -> CodeGenFunction r b) -> T a -> T b
lift1 a -> CodeGenFunction r a
forall r. a -> CodeGenFunction r a
forall a r. Additive a => a -> CodeGenFunction r a
A.neg

instance (A.PseudoRing a, A.IntegerConstant a) => Ring.C (T a) where
   one :: T a
one = a -> T a
forall a. a -> T a
constantValue a
forall a. IntegerConstant a => a
A.one
   * :: T a -> T a -> T a
(*) = (forall r. a -> a -> CodeGenFunction r a) -> T a -> T a -> T a
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T a -> T b -> T c
lift2 a -> a -> CodeGenFunction r a
forall r. a -> a -> CodeGenFunction r a
forall a r. PseudoRing a => a -> a -> CodeGenFunction r a
A.mul
   fromInteger :: Integer -> T a
fromInteger = Integer -> T a
forall a. IntegerConstant a => Integer -> T a
fromInteger'

{-
This instance is enough for Module here.
The difference to Module instances on Haskell tuples is,
that LLVM vectors cannot be nested.
-}
instance (a ~ A.Scalar v, A.PseudoModule v, A.IntegerConstant a) =>
      Module.C (T a) (T v) where
   *> :: T a -> T v -> T v
(*>) = (forall r. a -> v -> CodeGenFunction r v) -> T a -> T v -> T v
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T a -> T b -> T c
lift2 a -> v -> CodeGenFunction r v
Scalar v -> v -> CodeGenFunction r v
forall r. a -> v -> CodeGenFunction r v
forall v r. PseudoModule v => Scalar v -> v -> CodeGenFunction r v
forall r. Scalar v -> v -> CodeGenFunction r v
A.scale

instance (A.Additive a, A.IntegerConstant a) => Enum (T a) where
   succ :: T a -> T a
succ T a
x = T a
x T a -> T a -> T a
forall a. C a => a -> a -> a
+ a -> T a
forall a. a -> T a
constantValue a
forall a. IntegerConstant a => a
A.one
   pred :: T a -> T a
pred T a
x = T a
x T a -> T a -> T a
forall a. C a => a -> a -> a
- a -> T a
forall a. a -> T a
constantValue a
forall a. IntegerConstant a => a
A.one
   fromEnum :: T a -> Int
fromEnum T a
_ = [Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"CodeGenFunction Value: fromEnum"
   toEnum :: Int -> T a
toEnum = a -> T a
forall a. a -> T a
constantValue (a -> T a) -> (Int -> a) -> Int -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. IntegerConstant a => Integer -> a
A.fromInteger' (Integer -> a) -> (Int -> Integer) -> Int -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a b. (C a, C b) => a -> b
fromIntegral

{-
instance (IsArithmetic a, Cmp a b, Num a, IsConst a) => Real (T a) where
   toRational _ = error "CodeGenFunction Value: toRational"

instance (Cmp a b, Num a, IsConst a, IsInteger a) => Integral (T a) where
   quot = lift2 idiv
   rem  = lift2 irem
   quotRem x y = (quot x y, rem x y)
   toInteger _ = error "CodeGenFunction Value: toInteger"
-}

instance (A.Field a, A.RationalConstant a) => Field.C (T a) where
   / :: T a -> T a -> T a
(/) = (forall r. a -> a -> CodeGenFunction r a) -> T a -> T a -> T a
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T a -> T b -> T c
lift2 a -> a -> CodeGenFunction r a
forall r. a -> a -> CodeGenFunction r a
forall a r. Field a => a -> a -> CodeGenFunction r a
A.fdiv
   fromRational' :: Rational -> T a
fromRational' = Rational -> T a
forall a. RationalConstant a => Rational -> T a
fromRational' (Rational -> T a) -> (Rational -> Rational) -> Rational -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Rational
forall a. C a => Rational -> a
Field.fromRational'

{-
instance (Cmp a b, Fractional a, IsConst a, IsFloating a) => RealFrac (T a) where
   properFraction _ = error "CodeGenFunction Value: properFraction"
-}

instance (A.Transcendental a, A.RationalConstant a) => Algebraic.C (T a) where
   sqrt :: T a -> T a
sqrt = (forall r. a -> CodeGenFunction r a) -> T a -> T a
forall a b. (forall r. a -> CodeGenFunction r b) -> T a -> T b
lift1 a -> CodeGenFunction r a
forall r. a -> CodeGenFunction r a
forall a r. Algebraic a => a -> CodeGenFunction r a
A.sqrt
   root :: Integer -> T a -> T a
root Integer
n T a
x = (forall r. a -> a -> CodeGenFunction r a) -> T a -> T a -> T a
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T a -> T b -> T c
lift2 a -> a -> CodeGenFunction r a
forall r. a -> a -> CodeGenFunction r a
forall a r. Transcendental a => a -> a -> CodeGenFunction r a
A.pow T a
x (T a
forall a. C a => a
one T a -> T a -> T a
forall a. C a => a -> a -> a
/ Integer -> T a
forall a. C a => Integer -> a
fromInteger Integer
n)
   T a
x^/ :: T a -> Rational -> T a
^/Rational
r = (forall r. a -> a -> CodeGenFunction r a) -> T a -> T a -> T a
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T a -> T b -> T c
lift2 a -> a -> CodeGenFunction r a
forall r. a -> a -> CodeGenFunction r a
forall a r. Transcendental a => a -> a -> CodeGenFunction r a
A.pow T a
x (Rational -> T a
forall a. C a => Rational -> a
Field.fromRational' Rational
r)

instance (A.Transcendental a, A.RationalConstant a) => Trans.C (T a) where
   pi :: T a
pi = (forall r. CodeGenFunction r a) -> T a
forall a. (forall r. CodeGenFunction r a) -> T a
lift0 CodeGenFunction r a
forall r. CodeGenFunction r a
forall a r. Transcendental a => CodeGenFunction r a
A.pi
   sin :: T a -> T a
sin = (forall r. a -> CodeGenFunction r a) -> T a -> T a
forall a b. (forall r. a -> CodeGenFunction r b) -> T a -> T b
lift1 a -> CodeGenFunction r a
forall r. a -> CodeGenFunction r a
forall a r. Transcendental a => a -> CodeGenFunction r a
A.sin
   cos :: T a -> T a
cos = (forall r. a -> CodeGenFunction r a) -> T a -> T a
forall a b. (forall r. a -> CodeGenFunction r b) -> T a -> T b
lift1 a -> CodeGenFunction r a
forall r. a -> CodeGenFunction r a
forall a r. Transcendental a => a -> CodeGenFunction r a
A.cos
   ** :: T a -> T a -> T a
(**) = (forall r. a -> a -> CodeGenFunction r a) -> T a -> T a -> T a
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T a -> T b -> T c
lift2 a -> a -> CodeGenFunction r a
forall r. a -> a -> CodeGenFunction r a
forall a r. Transcendental a => a -> a -> CodeGenFunction r a
A.pow
   exp :: T a -> T a
exp = (forall r. a -> CodeGenFunction r a) -> T a -> T a
forall a b. (forall r. a -> CodeGenFunction r b) -> T a -> T b
lift1 a -> CodeGenFunction r a
forall r. a -> CodeGenFunction r a
forall a r. Transcendental a => a -> CodeGenFunction r a
A.exp
   log :: T a -> T a
log = (forall r. a -> CodeGenFunction r a) -> T a -> T a
forall a b. (forall r. a -> CodeGenFunction r b) -> T a -> T b
lift1 a -> CodeGenFunction r a
forall r. a -> CodeGenFunction r a
forall a r. Transcendental a => a -> CodeGenFunction r a
A.log

   asin :: T a -> T a
asin T a
_ = [Char] -> T a
forall a. HasCallStack => [Char] -> a
error [Char]
"LLVM missing intrinsic: asin"
   acos :: T a -> T a
acos T a
_ = [Char] -> T a
forall a. HasCallStack => [Char] -> a
error [Char]
"LLVM missing intrinsic: acos"
   atan :: T a -> T a
atan T a
_ = [Char] -> T a
forall a. HasCallStack => [Char] -> a
error [Char]
"LLVM missing intrinsic: atan"


instance
   (A.PseudoRing a, A.Real a, A.IntegerConstant a) =>
      P.Num (T a) where
   fromInteger :: Integer -> T a
fromInteger = Integer -> T a
forall a. IntegerConstant a => Integer -> T a
fromInteger'
   + :: T a -> T a -> T a
(+) = (forall r. a -> a -> CodeGenFunction r a) -> T a -> T a -> T a
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T a -> T b -> T c
lift2 a -> a -> CodeGenFunction r a
forall r. a -> a -> CodeGenFunction r a
forall a r. Additive a => a -> a -> CodeGenFunction r a
A.add
   (-) = (forall r. a -> a -> CodeGenFunction r a) -> T a -> T a -> T a
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T a -> T b -> T c
lift2 a -> a -> CodeGenFunction r a
forall r. a -> a -> CodeGenFunction r a
forall a r. Additive a => a -> a -> CodeGenFunction r a
A.sub
   * :: T a -> T a -> T a
(*) = (forall r. a -> a -> CodeGenFunction r a) -> T a -> T a -> T a
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T a -> T b -> T c
lift2 a -> a -> CodeGenFunction r a
forall r. a -> a -> CodeGenFunction r a
forall a r. PseudoRing a => a -> a -> CodeGenFunction r a
A.mul
   negate :: T a -> T a
negate = (forall r. a -> CodeGenFunction r a) -> T a -> T a
forall a b. (forall r. a -> CodeGenFunction r b) -> T a -> T b
lift1 a -> CodeGenFunction r a
forall r. a -> CodeGenFunction r a
forall a r. Additive a => a -> CodeGenFunction r a
A.neg
   abs :: T a -> T a
abs = (forall r. a -> CodeGenFunction r a) -> T a -> T a
forall a b. (forall r. a -> CodeGenFunction r b) -> T a -> T b
lift1 a -> CodeGenFunction r a
forall r. a -> CodeGenFunction r a
forall a r. Real a => a -> CodeGenFunction r a
A.abs
   signum :: T a -> T a
signum = (forall r. a -> CodeGenFunction r a) -> T a -> T a
forall a b. (forall r. a -> CodeGenFunction r b) -> T a -> T b
lift1 a -> CodeGenFunction r a
forall r. a -> CodeGenFunction r a
forall a r. Real a => a -> CodeGenFunction r a
A.signum

instance
   (A.Field a, A.Real a, A.RationalConstant a) =>
      P.Fractional (T a) where
   fromRational :: Rational -> T a
fromRational = Rational -> T a
forall a. RationalConstant a => Rational -> T a
fromRational'
   / :: T a -> T a -> T a
(/) = (forall r. a -> a -> CodeGenFunction r a) -> T a -> T a -> T a
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T a -> T b -> T c
lift2 a -> a -> CodeGenFunction r a
forall r. a -> a -> CodeGenFunction r a
forall a r. Field a => a -> a -> CodeGenFunction r a
A.fdiv

instance
   (A.Transcendental a, A.Real a, A.RationalConstant a) =>
      P.Floating (T a) where
   pi :: T a
pi = (forall r. CodeGenFunction r a) -> T a
forall a. (forall r. CodeGenFunction r a) -> T a
lift0 CodeGenFunction r a
forall r. CodeGenFunction r a
forall a r. Transcendental a => CodeGenFunction r a
A.pi
   sin :: T a -> T a
sin = (forall r. a -> CodeGenFunction r a) -> T a -> T a
forall a b. (forall r. a -> CodeGenFunction r b) -> T a -> T b
lift1 a -> CodeGenFunction r a
forall r. a -> CodeGenFunction r a
forall a r. Transcendental a => a -> CodeGenFunction r a
A.sin
   cos :: T a -> T a
cos = (forall r. a -> CodeGenFunction r a) -> T a -> T a
forall a b. (forall r. a -> CodeGenFunction r b) -> T a -> T b
lift1 a -> CodeGenFunction r a
forall r. a -> CodeGenFunction r a
forall a r. Transcendental a => a -> CodeGenFunction r a
A.cos
   ** :: T a -> T a -> T a
(**) = (forall r. a -> a -> CodeGenFunction r a) -> T a -> T a -> T a
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T a -> T b -> T c
lift2 a -> a -> CodeGenFunction r a
forall r. a -> a -> CodeGenFunction r a
forall a r. Transcendental a => a -> a -> CodeGenFunction r a
A.pow
   exp :: T a -> T a
exp = (forall r. a -> CodeGenFunction r a) -> T a -> T a
forall a b. (forall r. a -> CodeGenFunction r b) -> T a -> T b
lift1 a -> CodeGenFunction r a
forall r. a -> CodeGenFunction r a
forall a r. Transcendental a => a -> CodeGenFunction r a
A.exp
   log :: T a -> T a
log = (forall r. a -> CodeGenFunction r a) -> T a -> T a
forall a b. (forall r. a -> CodeGenFunction r b) -> T a -> T b
lift1 a -> CodeGenFunction r a
forall r. a -> CodeGenFunction r a
forall a r. Transcendental a => a -> CodeGenFunction r a
A.log

   asin :: T a -> T a
asin T a
_ = [Char] -> T a
forall a. HasCallStack => [Char] -> a
error [Char]
"LLVM missing intrinsic: asin"
   acos :: T a -> T a
acos T a
_ = [Char] -> T a
forall a. HasCallStack => [Char] -> a
error [Char]
"LLVM missing intrinsic: acos"
   atan :: T a -> T a
atan T a
_ = [Char] -> T a
forall a. HasCallStack => [Char] -> a
error [Char]
"LLVM missing intrinsic: atan"

   sinh :: T a -> T a
sinh T a
x  = (T a -> T a
forall a. C a => a -> a
exp T a
x T a -> T a -> T a
forall a. C a => a -> a -> a
- T a -> T a
forall a. C a => a -> a
exp (-T a
x)) T a -> T a -> T a
forall a. C a => a -> a -> a
/ T a
2
   cosh :: T a -> T a
cosh T a
x  = (T a -> T a
forall a. C a => a -> a
exp T a
x T a -> T a -> T a
forall a. C a => a -> a -> a
+ T a -> T a
forall a. C a => a -> a
exp (-T a
x)) T a -> T a -> T a
forall a. C a => a -> a -> a
/ T a
2
   asinh :: T a -> T a
asinh T a
x = T a -> T a
forall a. C a => a -> a
log (T a
x T a -> T a -> T a
forall a. C a => a -> a -> a
+ T a -> T a
forall a. Algebraic a => T a -> T a
sqrt (T a
xT a -> T a -> T a
forall a. C a => a -> a -> a
*T a
x T a -> T a -> T a
forall a. C a => a -> a -> a
+ T a
1))
   acosh :: T a -> T a
acosh T a
x = T a -> T a
forall a. C a => a -> a
log (T a
x T a -> T a -> T a
forall a. C a => a -> a -> a
+ T a -> T a
forall a. Algebraic a => T a -> T a
sqrt (T a
xT a -> T a -> T a
forall a. C a => a -> a -> a
*T a
x T a -> T a -> T a
forall a. C a => a -> a -> a
- T a
1))
   atanh :: T a -> T a
atanh T a
x = (T a -> T a
forall a. C a => a -> a
log (T a
1 T a -> T a -> T a
forall a. C a => a -> a -> a
+ T a
x) T a -> T a -> T a
forall a. C a => a -> a -> a
- T a -> T a
forall a. C a => a -> a
log (T a
1 T a -> T a -> T a
forall a. C a => a -> a -> a
- T a
x)) T a -> T a -> T a
forall a. C a => a -> a -> a
/ T a
2


tau ::
   (A.Transcendental a, A.RationalConstant a) =>
   T a
tau :: forall a. (Transcendental a, RationalConstant a) => T a
tau = Integer -> T a
forall a. C a => Integer -> a
fromInteger Integer
2 T a -> T a -> T a
forall a. C a => a -> a -> a
* T a
forall a. C a => a
Trans.pi

square :: (A.PseudoRing a) => T a -> T a
square :: forall a. PseudoRing a => T a -> T a
square = (forall r. a -> CodeGenFunction r a) -> T a -> T a
forall a b. (forall r. a -> CodeGenFunction r b) -> T a -> T b
lift1 a -> CodeGenFunction r a
forall r. a -> CodeGenFunction r a
forall a r. PseudoRing a => a -> CodeGenFunction r a
A.square

{- |
The same as 'Algebraic.sqrt',
but needs only Algebraic constraint, not Transcendental.
-}
sqrt ::
   (A.Algebraic a) =>
   T a -> T a
sqrt :: forall a. Algebraic a => T a -> T a
sqrt = (forall r. a -> CodeGenFunction r a) -> T a -> T a
forall a b. (forall r. a -> CodeGenFunction r b) -> T a -> T b
lift1 a -> CodeGenFunction r a
forall r. a -> CodeGenFunction r a
forall a r. Algebraic a => a -> CodeGenFunction r a
A.sqrt


min, max :: (A.Real a) => T a -> T a -> T a
min :: forall a. Real a => T a -> T a -> T a
min = (forall r. a -> a -> CodeGenFunction r a) -> T a -> T a -> T a
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T a -> T b -> T c
lift2 a -> a -> CodeGenFunction r a
forall r. a -> a -> CodeGenFunction r a
forall a r. Real a => a -> a -> CodeGenFunction r a
A.min
max :: forall a. Real a => T a -> T a -> T a
max = (forall r. a -> a -> CodeGenFunction r a) -> T a -> T a -> T a
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T a -> T b -> T c
lift2 a -> a -> CodeGenFunction r a
forall r. a -> a -> CodeGenFunction r a
forall a r. Real a => a -> a -> CodeGenFunction r a
A.max

limit :: (A.Real a) => (T a, T a) -> T a -> T a
limit :: forall a. Real a => (T a, T a) -> T a -> T a
limit (T a
l,T a
u) = T a -> T a -> T a
forall a. Real a => T a -> T a -> T a
max T a
l (T a -> T a) -> (T a -> T a) -> T a -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> T a -> T a
forall a. Real a => T a -> T a -> T a
min T a
u

fraction :: (A.Fraction a) => T a -> T a
fraction :: forall a. Fraction a => T a -> T a
fraction = (forall r. a -> CodeGenFunction r a) -> T a -> T a
forall a b. (forall r. a -> CodeGenFunction r b) -> T a -> T b
lift1 a -> CodeGenFunction r a
forall r. a -> CodeGenFunction r a
forall a r. Fraction a => a -> CodeGenFunction r a
A.fraction


instance (A.Real a, A.PseudoRing a, A.IntegerConstant a) =>
      Absolute.C (T a) where
   abs :: T a -> T a
abs = (forall r. a -> CodeGenFunction r a) -> T a -> T a
forall a b. (forall r. a -> CodeGenFunction r b) -> T a -> T b
lift1 a -> CodeGenFunction r a
forall r. a -> CodeGenFunction r a
forall a r. Real a => a -> CodeGenFunction r a
A.abs
   signum :: T a -> T a
signum = (forall r. a -> CodeGenFunction r a) -> T a -> T a
forall a b. (forall r. a -> CodeGenFunction r b) -> T a -> T b
lift1 a -> CodeGenFunction r a
forall r. a -> CodeGenFunction r a
forall a r. Real a => a -> CodeGenFunction r a
A.signum

{-
For useful instances with different scalar and vector type,
we would need a more flexible superclass.
-}
instance (A.Real a, A.IntegerConstant a, a ~ A.Scalar a, A.PseudoModule a) =>
      NormedSum.C (T a) (T a) where
   norm :: T a -> T a
norm = (forall r. a -> CodeGenFunction r a) -> T a -> T a
forall a b. (forall r. a -> CodeGenFunction r b) -> T a -> T b
lift1 a -> CodeGenFunction r a
forall r. a -> CodeGenFunction r a
forall a r. Real a => a -> CodeGenFunction r a
A.abs

instance (A.Real a, A.IntegerConstant a, a ~ A.Scalar a, A.PseudoModule a) =>
      NormedEuc.Sqr (T a) (T a) where
   normSqr :: T a -> T a
normSqr = (forall r. a -> CodeGenFunction r a) -> T a -> T a
forall a b. (forall r. a -> CodeGenFunction r b) -> T a -> T b
lift1 a -> CodeGenFunction r a
forall r. a -> CodeGenFunction r a
forall a r. PseudoRing a => a -> CodeGenFunction r a
A.square

instance
   (NormedEuc.Sqr (T a) (T v),
    A.RationalConstant a, A.Algebraic a) =>
      NormedEuc.C (T a) (T v) where
   norm :: T v -> T a
norm = (forall r. a -> CodeGenFunction r a) -> T a -> T a
forall a b. (forall r. a -> CodeGenFunction r b) -> T a -> T b
lift1 a -> CodeGenFunction r a
forall r. a -> CodeGenFunction r a
forall a r. Algebraic a => a -> CodeGenFunction r a
A.sqrt (T a -> T a) -> (T v -> T a) -> T v -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T v -> T a
forall a v. Sqr a v => v -> a
NormedEuc.normSqr

{-
instance (A.Real a, A.IntegerConstant a, A.PseudoModule a a) =>
      NormedMax.C (T a) (T a) where
   norm = lift1 A.abs
-}


infix  4  %==, %/=, %<, %<=, %>=, %>

(%==), (%/=), (%<), (%<=), (%>), (%>=) ::
   (LLVM.CmpRet a) =>
   T (LLVM.Value a) -> T (LLVM.Value a) -> T (LLVM.Value (LLVM.CmpResult a))
%== :: forall a.
CmpRet a =>
T (Value a) -> T (Value a) -> T (Value (CmpResult a))
(%==) = (forall r.
 Value a -> Value a -> CodeGenFunction r (Value (CmpResult a)))
-> T (Value a) -> T (Value a) -> T (Value (CmpResult a))
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T a -> T b -> T c
lift2 ((forall r.
  Value a -> Value a -> CodeGenFunction r (Value (CmpResult a)))
 -> T (Value a) -> T (Value a) -> T (Value (CmpResult a)))
-> (forall r.
    Value a -> Value a -> CodeGenFunction r (Value (CmpResult a)))
-> T (Value a)
-> T (Value a)
-> T (Value (CmpResult a))
forall a b. (a -> b) -> a -> b
$ CmpPredicate
-> Value a
-> Value a
-> CodeGenFunction r (CmpValueResult Value Value a)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, CmpRet a) =>
CmpPredicate
-> value0 a
-> value1 a
-> CodeGenFunction r (CmpValueResult value0 value1 a)
LLVM.cmp CmpPredicate
LLVM.CmpEQ
%/= :: forall a.
CmpRet a =>
T (Value a) -> T (Value a) -> T (Value (CmpResult a))
(%/=) = (forall r.
 Value a -> Value a -> CodeGenFunction r (Value (CmpResult a)))
-> T (Value a) -> T (Value a) -> T (Value (CmpResult a))
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T a -> T b -> T c
lift2 ((forall r.
  Value a -> Value a -> CodeGenFunction r (Value (CmpResult a)))
 -> T (Value a) -> T (Value a) -> T (Value (CmpResult a)))
-> (forall r.
    Value a -> Value a -> CodeGenFunction r (Value (CmpResult a)))
-> T (Value a)
-> T (Value a)
-> T (Value (CmpResult a))
forall a b. (a -> b) -> a -> b
$ CmpPredicate
-> Value a
-> Value a
-> CodeGenFunction r (CmpValueResult Value Value a)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, CmpRet a) =>
CmpPredicate
-> value0 a
-> value1 a
-> CodeGenFunction r (CmpValueResult value0 value1 a)
LLVM.cmp CmpPredicate
LLVM.CmpNE
%> :: forall a.
CmpRet a =>
T (Value a) -> T (Value a) -> T (Value (CmpResult a))
(%>)  = (forall r.
 Value a -> Value a -> CodeGenFunction r (Value (CmpResult a)))
-> T (Value a) -> T (Value a) -> T (Value (CmpResult a))
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T a -> T b -> T c
lift2 ((forall r.
  Value a -> Value a -> CodeGenFunction r (Value (CmpResult a)))
 -> T (Value a) -> T (Value a) -> T (Value (CmpResult a)))
-> (forall r.
    Value a -> Value a -> CodeGenFunction r (Value (CmpResult a)))
-> T (Value a)
-> T (Value a)
-> T (Value (CmpResult a))
forall a b. (a -> b) -> a -> b
$ CmpPredicate
-> Value a
-> Value a
-> CodeGenFunction r (CmpValueResult Value Value a)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, CmpRet a) =>
CmpPredicate
-> value0 a
-> value1 a
-> CodeGenFunction r (CmpValueResult value0 value1 a)
LLVM.cmp CmpPredicate
LLVM.CmpGT
%>= :: forall a.
CmpRet a =>
T (Value a) -> T (Value a) -> T (Value (CmpResult a))
(%>=) = (forall r.
 Value a -> Value a -> CodeGenFunction r (Value (CmpResult a)))
-> T (Value a) -> T (Value a) -> T (Value (CmpResult a))
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T a -> T b -> T c
lift2 ((forall r.
  Value a -> Value a -> CodeGenFunction r (Value (CmpResult a)))
 -> T (Value a) -> T (Value a) -> T (Value (CmpResult a)))
-> (forall r.
    Value a -> Value a -> CodeGenFunction r (Value (CmpResult a)))
-> T (Value a)
-> T (Value a)
-> T (Value (CmpResult a))
forall a b. (a -> b) -> a -> b
$ CmpPredicate
-> Value a
-> Value a
-> CodeGenFunction r (CmpValueResult Value Value a)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, CmpRet a) =>
CmpPredicate
-> value0 a
-> value1 a
-> CodeGenFunction r (CmpValueResult value0 value1 a)
LLVM.cmp CmpPredicate
LLVM.CmpGE
%< :: forall a.
CmpRet a =>
T (Value a) -> T (Value a) -> T (Value (CmpResult a))
(%<)  = (forall r.
 Value a -> Value a -> CodeGenFunction r (Value (CmpResult a)))
-> T (Value a) -> T (Value a) -> T (Value (CmpResult a))
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T a -> T b -> T c
lift2 ((forall r.
  Value a -> Value a -> CodeGenFunction r (Value (CmpResult a)))
 -> T (Value a) -> T (Value a) -> T (Value (CmpResult a)))
-> (forall r.
    Value a -> Value a -> CodeGenFunction r (Value (CmpResult a)))
-> T (Value a)
-> T (Value a)
-> T (Value (CmpResult a))
forall a b. (a -> b) -> a -> b
$ CmpPredicate
-> Value a
-> Value a
-> CodeGenFunction r (CmpValueResult Value Value a)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, CmpRet a) =>
CmpPredicate
-> value0 a
-> value1 a
-> CodeGenFunction r (CmpValueResult value0 value1 a)
LLVM.cmp CmpPredicate
LLVM.CmpLT
%<= :: forall a.
CmpRet a =>
T (Value a) -> T (Value a) -> T (Value (CmpResult a))
(%<=) = (forall r.
 Value a -> Value a -> CodeGenFunction r (Value (CmpResult a)))
-> T (Value a) -> T (Value a) -> T (Value (CmpResult a))
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T a -> T b -> T c
lift2 ((forall r.
  Value a -> Value a -> CodeGenFunction r (Value (CmpResult a)))
 -> T (Value a) -> T (Value a) -> T (Value (CmpResult a)))
-> (forall r.
    Value a -> Value a -> CodeGenFunction r (Value (CmpResult a)))
-> T (Value a)
-> T (Value a)
-> T (Value (CmpResult a))
forall a b. (a -> b) -> a -> b
$ CmpPredicate
-> Value a
-> Value a
-> CodeGenFunction r (CmpValueResult Value Value a)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, CmpRet a) =>
CmpPredicate
-> value0 a
-> value1 a
-> CodeGenFunction r (CmpValueResult value0 value1 a)
LLVM.cmp CmpPredicate
LLVM.CmpLE

infixr 3  %&&
infixr 2  %||

-- | Lazy AND
(%&&) :: T (LLVM.Value Bool) -> T (LLVM.Value Bool) -> T (LLVM.Value Bool)
T (Value Bool)
a %&& :: T (Value Bool) -> T (Value Bool) -> T (Value Bool)
%&& T (Value Bool)
b = T (Value Bool)
a T (Value Bool)
-> (T (Value Bool), T (Value Bool)) -> T (Value Bool)
forall value a.
(Flatten value, Registers value ~ a, Phi a) =>
T (Value Bool) -> (value, value) -> value
? (T (Value Bool)
b, Bool -> T (Value Bool)
forall a. IsConst a => a -> T (Value a)
constant Bool
False)

-- | Lazy OR
(%||) :: T (LLVM.Value Bool) -> T (LLVM.Value Bool) -> T (LLVM.Value Bool)
T (Value Bool)
a %|| :: T (Value Bool) -> T (Value Bool) -> T (Value Bool)
%|| T (Value Bool)
b = T (Value Bool)
a T (Value Bool)
-> (T (Value Bool), T (Value Bool)) -> T (Value Bool)
forall value a.
(Flatten value, Registers value ~ a, Phi a) =>
T (Value Bool) -> (value, value) -> value
? (Bool -> T (Value Bool)
forall a. IsConst a => a -> T (Value a)
constant Bool
True, T (Value Bool)
b)

not :: T (LLVM.Value Bool) -> T (LLVM.Value Bool)
not :: T (Value Bool) -> T (Value Bool)
not = (forall r. Value Bool -> CodeGenFunction r (Value Bool))
-> T (Value Bool) -> T (Value Bool)
forall a b. (forall r. a -> CodeGenFunction r b) -> T a -> T b
lift1 Value Bool -> CodeGenFunction r (Value Bool)
forall r. Value Bool -> CodeGenFunction r (Value Bool)
forall (value :: * -> *) a r.
(ValueCons value, IsInteger a) =>
value a -> CodeGenFunction r (value a)
LLVM.inv


infix  0 ?
{- |
@true ? (t,f)@ evaluates @t@,
@false ? (t,f)@ evaluates @f@.
@t@ and @f@ can reuse interim results,
but they cannot contribute shared results,
since only one of them will be run.
Cf. '(??)'
-}
(?) ::
   (Flatten value, Registers value ~ a, Tuple.Phi a) =>
   T (LLVM.Value Bool) -> (value, value) -> value
T (Value Bool)
c ? :: forall value a.
(Flatten value, Registers value ~ a, Phi a) =>
T (Value Bool) -> (value, value) -> value
? (value
t, value
f) =
   T (Registers value) -> value
forall value. Flatten value => T (Registers value) -> value
unfoldCode (T (Registers value) -> value) -> T (Registers value) -> value
forall a b. (a -> b) -> a -> b
$ (forall r. Compute r (Registers value)) -> T (Registers value)
forall a. (forall r. Compute r a) -> T a
consUnique ((forall r. Compute r (Registers value)) -> T (Registers value))
-> (forall r. Compute r (Registers value)) -> T (Registers value)
forall a b. (a -> b) -> a -> b
$ do
      Value Bool
b <- T (Value Bool) -> forall r. Compute r (Value Bool)
forall a. T a -> forall r. Compute r a
code T (Value Bool)
c
      Vault
shared <- StateT Vault (CodeGenFunction r) Vault
forall (m :: * -> *) s. Monad m => StateT s m s
MS.get
      CodeGenFunction r a -> StateT Vault (CodeGenFunction r) a
forall (m :: * -> *) a. Monad m => m a -> StateT Vault m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift (CodeGenFunction r a -> StateT Vault (CodeGenFunction r) a)
-> CodeGenFunction r a -> StateT Vault (CodeGenFunction r) a
forall a b. (a -> b) -> a -> b
$
         Value Bool
-> CodeGenFunction r a
-> CodeGenFunction r a
-> CodeGenFunction r a
forall a r.
Phi a =>
Value Bool
-> CodeGenFunction r a
-> CodeGenFunction r a
-> CodeGenFunction r a
C.ifThenElse Value Bool
b
            (StateT Vault (CodeGenFunction r) a -> Vault -> CodeGenFunction r a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
MS.evalStateT (value -> Compute r (Registers value)
forall r. value -> Compute r (Registers value)
forall value r.
Flatten value =>
value -> Compute r (Registers value)
flattenCode value
t) Vault
shared)
            (StateT Vault (CodeGenFunction r) a -> Vault -> CodeGenFunction r a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
MS.evalStateT (value -> Compute r (Registers value)
forall r. value -> Compute r (Registers value)
forall value r.
Flatten value =>
value -> Compute r (Registers value)
flattenCode value
f) Vault
shared)

infix 0 ??
{- |
The expression @c ?? (t,f)@ evaluates both @t@ and @f@
and selects components from @t@ and @f@ according to @c@.
It is useful for vector values and
for sharing @t@ or @f@ with other branches of an expression.
-}
(??) ::
   (LLVM.IsFirstClass a, LLVM.CmpRet a) =>
   T (LLVM.Value (LLVM.CmpResult a)) ->
   (T (LLVM.Value a), T (LLVM.Value a)) ->
   T (LLVM.Value a)
T (Value (CmpResult a))
c ?? :: forall a.
(IsFirstClass a, CmpRet a) =>
T (Value (CmpResult a))
-> (T (Value a), T (Value a)) -> T (Value a)
?? (T (Value a)
t, T (Value a)
f) = (forall r.
 Value (CmpResult a)
 -> Value a -> Value a -> CodeGenFunction r (Value a))
-> T (Value (CmpResult a))
-> T (Value a)
-> T (Value a)
-> T (Value a)
forall a b c d.
(forall r. a -> b -> c -> CodeGenFunction r d)
-> T a -> T b -> T c -> T d
lift3 Value (CmpResult a)
-> Value a -> Value a -> CodeGenFunction r (Value a)
forall r.
Value (CmpResult a)
-> Value a -> Value a -> CodeGenFunction r (Value a)
forall a r.
CmpRet a =>
Value (CmpResult a)
-> Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.select T (Value (CmpResult a))
c T (Value a)
t T (Value a)
f



lift0 ::
   (forall r. LLVM.CodeGenFunction r a) ->
   T a
lift0 :: forall a. (forall r. CodeGenFunction r a) -> T a
lift0 forall r. CodeGenFunction r a
f =
   (forall r. Compute r a) -> T a
forall a. (forall r. Compute r a) -> T a
consUnique ((forall r. Compute r a) -> T a) -> (forall r. Compute r a) -> T a
forall a b. (a -> b) -> a -> b
$ CodeGenFunction r a -> StateT Vault (CodeGenFunction r) a
forall (m :: * -> *) a. Monad m => m a -> StateT Vault m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift (CodeGenFunction r a -> StateT Vault (CodeGenFunction r) a)
-> CodeGenFunction r a -> StateT Vault (CodeGenFunction r) a
forall a b. (a -> b) -> a -> b
$ CodeGenFunction r a
forall r. CodeGenFunction r a
f

lift1 ::
   (forall r. a -> LLVM.CodeGenFunction r b) ->
   T a -> T b
lift1 :: forall a b. (forall r. a -> CodeGenFunction r b) -> T a -> T b
lift1 forall r. a -> CodeGenFunction r b
f T a
x =
   (forall r. Compute r b) -> T b
forall a. (forall r. Compute r a) -> T a
consUnique ((forall r. Compute r b) -> T b) -> (forall r. Compute r b) -> T b
forall a b. (a -> b) -> a -> b
$ CodeGenFunction r b -> StateT Vault (CodeGenFunction r) b
forall (m :: * -> *) a. Monad m => m a -> StateT Vault m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift (CodeGenFunction r b -> StateT Vault (CodeGenFunction r) b)
-> (a -> CodeGenFunction r b)
-> a
-> StateT Vault (CodeGenFunction r) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> CodeGenFunction r b
forall r. a -> CodeGenFunction r b
f (a -> StateT Vault (CodeGenFunction r) b)
-> StateT Vault (CodeGenFunction r) a
-> StateT Vault (CodeGenFunction r) b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< T a -> forall r. Compute r a
forall a. T a -> forall r. Compute r a
code T a
x

lift2 ::
   (forall r. a -> b -> LLVM.CodeGenFunction r c) ->
   T a -> T b -> T c
lift2 :: forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T a -> T b -> T c
lift2 forall r. a -> b -> CodeGenFunction r c
f T a
x T b
y =
   (forall r. Compute r c) -> T c
forall a. (forall r. Compute r a) -> T a
consUnique ((forall r. Compute r c) -> T c) -> (forall r. Compute r c) -> T c
forall a b. (a -> b) -> a -> b
$ do
      a
xv <- T a -> forall r. Compute r a
forall a. T a -> forall r. Compute r a
code T a
x
      b
yv <- T b -> forall r. Compute r b
forall a. T a -> forall r. Compute r a
code T b
y
      CodeGenFunction r c -> Compute r c
forall (m :: * -> *) a. Monad m => m a -> StateT Vault m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift (CodeGenFunction r c -> Compute r c)
-> CodeGenFunction r c -> Compute r c
forall a b. (a -> b) -> a -> b
$ a -> b -> CodeGenFunction r c
forall r. a -> b -> CodeGenFunction r c
f a
xv b
yv

lift3 ::
   (forall r. a -> b -> c -> LLVM.CodeGenFunction r d) ->
   T a -> T b -> T c -> T d
lift3 :: forall a b c d.
(forall r. a -> b -> c -> CodeGenFunction r d)
-> T a -> T b -> T c -> T d
lift3 forall r. a -> b -> c -> CodeGenFunction r d
f T a
x T b
y T c
z =
   (forall r. Compute r d) -> T d
forall a. (forall r. Compute r a) -> T a
consUnique ((forall r. Compute r d) -> T d) -> (forall r. Compute r d) -> T d
forall a b. (a -> b) -> a -> b
$ do
      a
xv <- T a -> forall r. Compute r a
forall a. T a -> forall r. Compute r a
code T a
x
      b
yv <- T b -> forall r. Compute r b
forall a. T a -> forall r. Compute r a
code T b
y
      c
zv <- T c -> forall r. Compute r c
forall a. T a -> forall r. Compute r a
code T c
z
      CodeGenFunction r d -> Compute r d
forall (m :: * -> *) a. Monad m => m a -> StateT Vault m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift (CodeGenFunction r d -> Compute r d)
-> CodeGenFunction r d -> Compute r d
forall a b. (a -> b) -> a -> b
$ a -> b -> c -> CodeGenFunction r d
forall r. a -> b -> c -> CodeGenFunction r d
f a
xv b
yv c
zv


_unlift0 ::
   T a ->
   (forall r. LLVM.CodeGenFunction r a)
_unlift0 :: forall a. T a -> forall r. CodeGenFunction r a
_unlift0 = T a -> CodeGenFunction r a
T a -> forall r. CodeGenFunction r a
forall a. T a -> forall r. CodeGenFunction r a
decons

unlift0 ::
   (Flatten value) =>
   value ->
   (forall r. LLVM.CodeGenFunction r (Registers value))
unlift0 :: forall value.
Flatten value =>
value -> forall r. CodeGenFunction r (Registers value)
unlift0 value
x = value -> CodeGenFunction r (Registers value)
forall value r.
Flatten value =>
value -> CodeGenFunction r (Registers value)
flatten value
x

_unlift1 ::
   (T a -> T b) ->
   (forall r. a -> LLVM.CodeGenFunction r b)
_unlift1 :: forall a b. (T a -> T b) -> forall r. a -> CodeGenFunction r b
_unlift1 = (T a -> T b) -> a -> CodeGenFunction r b
(T a -> T b) -> forall r. a -> CodeGenFunction r (Registers (T b))
forall value a.
Flatten value =>
(T a -> value)
-> forall r. a -> CodeGenFunction r (Registers value)
unlift1

{-
Better type inference than flattenFunction.
-}
unlift1 ::
   (Flatten value) =>
   (T a -> value) ->
   (forall r. a -> LLVM.CodeGenFunction r (Registers value))
unlift1 :: forall value a.
Flatten value =>
(T a -> value)
-> forall r. a -> CodeGenFunction r (Registers value)
unlift1 T a -> value
f a
a =
   value -> CodeGenFunction r (Registers value)
forall value r.
Flatten value =>
value -> CodeGenFunction r (Registers value)
flatten (T a -> value
f (a -> T a
forall a. a -> T a
constantValue a
a))

_unlift2 ::
   (T a -> T b -> T c) ->
   (forall r. a -> b -> LLVM.CodeGenFunction r c)
_unlift2 :: forall a b c.
(T a -> T b -> T c) -> forall r. a -> b -> CodeGenFunction r c
_unlift2 = (T a -> T b -> T c) -> a -> b -> CodeGenFunction r c
(T a -> T b -> T c)
-> forall r. a -> b -> CodeGenFunction r (Registers (T c))
forall value a b.
Flatten value =>
(T a -> T b -> value)
-> forall r. a -> b -> CodeGenFunction r (Registers value)
unlift2

unlift2 ::
   (Flatten value) =>
   (T a -> T b -> value) ->
   (forall r. a -> b -> LLVM.CodeGenFunction r (Registers value))
unlift2 :: forall value a b.
Flatten value =>
(T a -> T b -> value)
-> forall r. a -> b -> CodeGenFunction r (Registers value)
unlift2 T a -> T b -> value
f a
a b
b =
   value -> CodeGenFunction r (Registers value)
forall value r.
Flatten value =>
value -> CodeGenFunction r (Registers value)
flatten (T a -> T b -> value
f (a -> T a
forall a. a -> T a
constantValue a
a) (b -> T b
forall a. a -> T a
constantValue b
b))

unlift3 ::
   (Flatten value) =>
   (T a -> T b -> T c -> value) ->
   (forall r. a -> b -> c -> LLVM.CodeGenFunction r (Registers value))
unlift3 :: forall value a b c.
Flatten value =>
(T a -> T b -> T c -> value)
-> forall r. a -> b -> c -> CodeGenFunction r (Registers value)
unlift3 T a -> T b -> T c -> value
f a
a b
b c
c =
   value -> CodeGenFunction r (Registers value)
forall value r.
Flatten value =>
value -> CodeGenFunction r (Registers value)
flatten (T a -> T b -> T c -> value
f (a -> T a
forall a. a -> T a
constantValue a
a) (b -> T b
forall a. a -> T a
constantValue b
b) (c -> T c
forall a. a -> T a
constantValue c
c))

unlift4 ::
   (Flatten value) =>
   (T a -> T b -> T c -> T d -> value) ->
   (forall r. a -> b -> c -> d -> LLVM.CodeGenFunction r (Registers value))
unlift4 :: forall value a b c d.
Flatten value =>
(T a -> T b -> T c -> T d -> value)
-> forall r.
   a -> b -> c -> d -> CodeGenFunction r (Registers value)
unlift4 T a -> T b -> T c -> T d -> value
f a
a b
b c
c d
d =
   value -> CodeGenFunction r (Registers value)
forall value r.
Flatten value =>
value -> CodeGenFunction r (Registers value)
flatten (value -> CodeGenFunction r (Registers value))
-> value -> CodeGenFunction r (Registers value)
forall a b. (a -> b) -> a -> b
$
   T a -> T b -> T c -> T d -> value
f (a -> T a
forall a. a -> T a
constantValue a
a) (b -> T b
forall a. a -> T a
constantValue b
b) (c -> T c
forall a. a -> T a
constantValue c
c) (d -> T d
forall a. a -> T a
constantValue d
d)

unlift5 ::
   (Flatten value) =>
   (T a -> T b -> T c -> T d -> T e -> value) ->
   (forall r. a -> b -> c -> d -> e -> LLVM.CodeGenFunction r (Registers value))
unlift5 :: forall value a b c d e.
Flatten value =>
(T a -> T b -> T c -> T d -> T e -> value)
-> forall r.
   a -> b -> c -> d -> e -> CodeGenFunction r (Registers value)
unlift5 T a -> T b -> T c -> T d -> T e -> value
f a
a b
b c
c d
d e
e =
   value -> CodeGenFunction r (Registers value)
forall value r.
Flatten value =>
value -> CodeGenFunction r (Registers value)
flatten (value -> CodeGenFunction r (Registers value))
-> value -> CodeGenFunction r (Registers value)
forall a b. (a -> b) -> a -> b
$
   T a -> T b -> T c -> T d -> T e -> value
f (a -> T a
forall a. a -> T a
constantValue a
a) (b -> T b
forall a. a -> T a
constantValue b
b) (c -> T c
forall a. a -> T a
constantValue c
c)
      (d -> T d
forall a. a -> T a
constantValue d
d) (e -> T e
forall a. a -> T a
constantValue e
e)


constantValue :: a -> T a
constantValue :: forall a. a -> T a
constantValue a
x =
   (forall r. Compute r a) -> T a
forall a. (forall r. Compute r a) -> T a
consUnique (a -> StateT Vault (CodeGenFunction r) a
forall a. a -> StateT Vault (CodeGenFunction r) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x)

constant :: (LLVM.IsConst a) => a -> T (LLVM.Value a)
constant :: forall a. IsConst a => a -> T (Value a)
constant = Value a -> T (Value a)
forall a. a -> T a
constantValue (Value a -> T (Value a)) -> (a -> Value a) -> a -> T (Value a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value a
forall a. IsConst a => a -> Value a
LLVM.valueOf

fromInteger' :: (A.IntegerConstant a) => Integer -> T a
fromInteger' :: forall a. IntegerConstant a => Integer -> T a
fromInteger' = a -> T a
forall a. a -> T a
constantValue (a -> T a) -> (Integer -> a) -> Integer -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. IntegerConstant a => Integer -> a
A.fromInteger'

fromRational' :: (A.RationalConstant a) => P.Rational -> T a
fromRational' :: forall a. RationalConstant a => Rational -> T a
fromRational' = a -> T a
forall a. a -> T a
constantValue (a -> T a) -> (Rational -> a) -> Rational -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> a
forall a. RationalConstant a => Rational -> a
A.fromRational'


class Flatten value where
   type Registers value
   flattenCode :: value -> Compute r (Registers value)
   unfoldCode :: T (Registers value) -> value

flatten ::
   (Flatten value) =>
   value -> LLVM.CodeGenFunction r (Registers value)
flatten :: forall value r.
Flatten value =>
value -> CodeGenFunction r (Registers value)
flatten value
x = StateT Vault (CodeGenFunction r) (Registers value)
-> Vault -> CodeGenFunction r (Registers value)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
MS.evalStateT (value -> StateT Vault (CodeGenFunction r) (Registers value)
forall r. value -> Compute r (Registers value)
forall value r.
Flatten value =>
value -> Compute r (Registers value)
flattenCode value
x) Vault
Vault.empty

unfold ::
   (Flatten value) =>
   (Registers value) -> value
unfold :: forall value. Flatten value => Registers value -> value
unfold Registers value
x = T (Registers value) -> value
forall value. Flatten value => T (Registers value) -> value
unfoldCode (T (Registers value) -> value) -> T (Registers value) -> value
forall a b. (a -> b) -> a -> b
$ Registers value -> T (Registers value)
forall a. a -> T a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Registers value
x

flattenCodeTraversable ::
   (Flatten value, Trav.Traversable f) =>
   f value -> Compute r (f (Registers value))
flattenCodeTraversable :: forall value (f :: * -> *) r.
(Flatten value, Traversable f) =>
f value -> Compute r (f (Registers value))
flattenCodeTraversable =
   (value -> StateT Vault (CodeGenFunction r) (Registers value))
-> f value
-> StateT Vault (CodeGenFunction r) (f (Registers value))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> f a -> m (f b)
Trav.mapM value -> StateT Vault (CodeGenFunction r) (Registers value)
forall r. value -> Compute r (Registers value)
forall value r.
Flatten value =>
value -> Compute r (Registers value)
flattenCode

unfoldCodeTraversable ::
   (Flatten value, Trav.Traversable f, Applicative f) =>
   T (f (Registers value)) -> f value
unfoldCodeTraversable :: forall value (f :: * -> *).
(Flatten value, Traversable f, Applicative f) =>
T (f (Registers value)) -> f value
unfoldCodeTraversable =
   f (f (Registers value) -> Registers value)
-> T (f (Registers value)) -> f value
forall (f :: * -> *) b a.
(Functor f, Flatten b) =>
f (a -> Registers b) -> T a -> f b
unfoldFromGetters f (f (Registers value) -> Registers value)
forall (f :: * -> *) a.
(Traversable f, Applicative f) =>
f (f a -> a)
getters

unfoldFromGetters ::
   (Functor f, Flatten b) =>
   f (a -> Registers b) -> T a -> f b
unfoldFromGetters :: forall (f :: * -> *) b a.
(Functor f, Flatten b) =>
f (a -> Registers b) -> T a -> f b
unfoldFromGetters f (a -> Registers b)
g T a
x =
   ((a -> Registers b) -> b) -> f (a -> Registers b) -> f b
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (T (Registers b) -> b
forall value. Flatten value => T (Registers value) -> value
unfoldCode (T (Registers b) -> b)
-> ((a -> Registers b) -> T (Registers b))
-> (a -> Registers b)
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> Registers b) -> T a -> T (Registers b))
-> T a -> (a -> Registers b) -> T (Registers b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> Registers b) -> T a -> T (Registers b)
forall a b. (a -> b) -> T a -> T b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap T a
x) f (a -> Registers b)
g

getters ::
   (Trav.Traversable f, Applicative f) =>
   f (f a -> a)
getters :: forall (f :: * -> *) a.
(Traversable f, Applicative f) =>
f (f a -> a)
getters =
   (Int -> f a -> a) -> f Int -> f (f a -> a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
n f a
x -> f a -> [a]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList f a
x [a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!! Int
n) (f Int -> f (f a -> a)) -> f Int -> f (f a -> a)
forall a b. (a -> b) -> a -> b
$
   State Int (f Int) -> Int -> f Int
forall s a. State s a -> s -> a
MS.evalState (f (StateT Int Identity Int) -> State Int (f Int)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => f (f a) -> f (f a)
Trav.sequenceA (StateT Int Identity Int -> f (StateT Int Identity Int)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Int -> (Int, Int)) -> StateT Int Identity Int
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
MS.state ((Int -> (Int, Int)) -> StateT Int Identity Int)
-> (Int -> (Int, Int)) -> StateT Int Identity Int
forall a b. (a -> b) -> a -> b
$ \Int
n -> (Int
n, Int -> Int
forall a. Enum a => a -> a
succ Int
n)))) Int
0


flattenFunction ::
   (Flatten a, Flatten b) =>
   (a -> b) -> (Registers a -> LLVM.CodeGenFunction r (Registers b))
flattenFunction :: forall a b r.
(Flatten a, Flatten b) =>
(a -> b) -> Registers a -> CodeGenFunction r (Registers b)
flattenFunction a -> b
f =
   b -> CodeGenFunction r (Registers b)
forall value r.
Flatten value =>
value -> CodeGenFunction r (Registers value)
flatten (b -> CodeGenFunction r (Registers b))
-> (Registers a -> b)
-> Registers a
-> CodeGenFunction r (Registers b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f (a -> b) -> (Registers a -> a) -> Registers a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Registers a -> a
forall value. Flatten value => Registers value -> value
unfold

{-
This function is hardly useful,
since most functions are not of type
@(Registers a -> (forall r. CodeGenFunction r (Registers b)))@
but of type
@(forall r. Registers a -> CodeGenFunction r (Registers b))@.
We would also need a method unfoldF.
See ValueUnfoldF for some implementations.

unfoldFunction ::
   (Flatten a, Flatten b) =>
   (Registers a -> (forall r. LLVM.CodeGenFunction r (Registers b))) -> (a -> b)
unfoldFunction f x =
   unfoldF (f =<< flatten x)
-}


instance (Flatten a, Flatten b) => Flatten (a,b) where
   type Registers (a,b) = (Registers a, Registers b)
   flattenCode :: forall r. (a, b) -> Compute r (Registers (a, b))
flattenCode (a
a,b
b) =
      (Registers a -> Registers b -> (Registers a, Registers b))
-> StateT Vault (CodeGenFunction r) (Registers a)
-> StateT Vault (CodeGenFunction r) (Registers b)
-> StateT Vault (CodeGenFunction r) (Registers a, Registers b)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (a -> StateT Vault (CodeGenFunction r) (Registers a)
forall r. a -> Compute r (Registers a)
forall value r.
Flatten value =>
value -> Compute r (Registers value)
flattenCode a
a) (b -> StateT Vault (CodeGenFunction r) (Registers b)
forall r. b -> Compute r (Registers b)
forall value r.
Flatten value =>
value -> Compute r (Registers value)
flattenCode b
b)
   unfoldCode :: T (Registers (a, b)) -> (a, b)
unfoldCode T (Registers (a, b))
x =
      case T (Registers a, Registers b) -> (T (Registers a), T (Registers b))
forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
unzip T (Registers a, Registers b)
T (Registers (a, b))
x of
         (T (Registers a)
a,T (Registers b)
b) -> (T (Registers a) -> a
forall value. Flatten value => T (Registers value) -> value
unfoldCode T (Registers a)
a, T (Registers b) -> b
forall value. Flatten value => T (Registers value) -> value
unfoldCode T (Registers b)
b)

instance (Flatten a, Flatten b, Flatten c) => Flatten (a,b,c) where
   type Registers (a,b,c) = (Registers a, Registers b, Registers c)
   flattenCode :: forall r. (a, b, c) -> Compute r (Registers (a, b, c))
flattenCode (a
a,b
b,c
c) =
      (Registers a
 -> Registers b
 -> Registers c
 -> (Registers a, Registers b, Registers c))
-> StateT Vault (CodeGenFunction r) (Registers a)
-> StateT Vault (CodeGenFunction r) (Registers b)
-> StateT Vault (CodeGenFunction r) (Registers c)
-> StateT
     Vault (CodeGenFunction r) (Registers a, Registers b, Registers c)
forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 (,,) (a -> StateT Vault (CodeGenFunction r) (Registers a)
forall r. a -> Compute r (Registers a)
forall value r.
Flatten value =>
value -> Compute r (Registers value)
flattenCode a
a) (b -> StateT Vault (CodeGenFunction r) (Registers b)
forall r. b -> Compute r (Registers b)
forall value r.
Flatten value =>
value -> Compute r (Registers value)
flattenCode b
b) (c -> StateT Vault (CodeGenFunction r) (Registers c)
forall r. c -> Compute r (Registers c)
forall value r.
Flatten value =>
value -> Compute r (Registers value)
flattenCode c
c)
   unfoldCode :: T (Registers (a, b, c)) -> (a, b, c)
unfoldCode T (Registers (a, b, c))
x =
      case T (Registers a, Registers b, Registers c)
-> (T (Registers a), T (Registers b), T (Registers c))
forall (f :: * -> *) a b c.
Functor f =>
f (a, b, c) -> (f a, f b, f c)
unzip3 T (Registers a, Registers b, Registers c)
T (Registers (a, b, c))
x of
         (T (Registers a)
a,T (Registers b)
b,T (Registers c)
c) -> (T (Registers a) -> a
forall value. Flatten value => T (Registers value) -> value
unfoldCode T (Registers a)
a, T (Registers b) -> b
forall value. Flatten value => T (Registers value) -> value
unfoldCode T (Registers b)
b, T (Registers c) -> c
forall value. Flatten value => T (Registers value) -> value
unfoldCode T (Registers c)
c)

instance Flatten a => Flatten (Complex.T a) where
   type Registers (Complex.T a) = Complex.T (Registers a)
--   flattenCode = flattenCodeTraversable
   flattenCode :: forall r. T a -> Compute r (Registers (T a))
flattenCode T a
s =
      (Registers a -> Registers a -> T (Registers a))
-> StateT Vault (CodeGenFunction r) (Registers a)
-> StateT Vault (CodeGenFunction r) (Registers a)
-> StateT Vault (CodeGenFunction r) (T (Registers a))
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Registers a -> Registers a -> T (Registers a)
forall a. a -> a -> T a
(Complex.+:)
         (a -> StateT Vault (CodeGenFunction r) (Registers a)
forall r. a -> Compute r (Registers a)
forall value r.
Flatten value =>
value -> Compute r (Registers value)
flattenCode (a -> StateT Vault (CodeGenFunction r) (Registers a))
-> a -> StateT Vault (CodeGenFunction r) (Registers a)
forall a b. (a -> b) -> a -> b
$ T a -> a
forall a. T a -> a
Complex.real T a
s)
         (a -> StateT Vault (CodeGenFunction r) (Registers a)
forall r. a -> Compute r (Registers a)
forall value r.
Flatten value =>
value -> Compute r (Registers value)
flattenCode (a -> StateT Vault (CodeGenFunction r) (Registers a))
-> a -> StateT Vault (CodeGenFunction r) (Registers a)
forall a b. (a -> b) -> a -> b
$ T a -> a
forall a. T a -> a
Complex.imag T a
s)
   unfoldCode :: T (Registers (T a)) -> T a
unfoldCode =
      T (Registers (T a) -> Registers a) -> T (Registers (T a)) -> T a
forall (f :: * -> *) b a.
(Functor f, Flatten b) =>
f (a -> Registers b) -> T a -> f b
unfoldFromGetters (T (Registers (T a) -> Registers a) -> T (Registers (T a)) -> T a)
-> T (Registers (T a) -> Registers a) -> T (Registers (T a)) -> T a
forall a b. (a -> b) -> a -> b
$ T (Registers a) -> Registers a
forall a. T a -> a
Complex.real (T (Registers a) -> Registers a)
-> (T (Registers a) -> Registers a)
-> T (T (Registers a) -> Registers a)
forall a. a -> a -> T a
Complex.+: T (Registers a) -> Registers a
forall a. T a -> a
Complex.imag


instance Flatten (T a) where
   type Registers (T a) = a
   flattenCode :: forall r. T a -> Compute r (Registers (T a))
flattenCode T a
x = T a -> forall r. Compute r a
forall a. T a -> forall r. Compute r a
code T a
x
   unfoldCode :: T (Registers (T a)) -> T a
unfoldCode = T a -> T a
T (Registers (T a)) -> T a
forall a. a -> a
id

instance Flatten () where
   type Registers () = ()
   flattenCode :: forall r. () -> Compute r (Registers ())
flattenCode = () -> StateT Vault (CodeGenFunction r) ()
() -> StateT Vault (CodeGenFunction r) (Registers ())
forall a. a -> StateT Vault (CodeGenFunction r) a
forall (m :: * -> *) a. Monad m => a -> m a
return
   unfoldCode :: T (Registers ()) -> ()
unfoldCode T (Registers ())
_ = ()