{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module LLVM.Extra.Multi.Value.Private where

import qualified LLVM.Extra.ScalarOrVector as SoV
import qualified LLVM.Extra.Arithmetic as A
import qualified LLVM.Extra.Control as C
import qualified LLVM.Extra.Tuple as Tuple
import qualified LLVM.Extra.Struct as Struct

import qualified LLVM.ExecutionEngine as EE
import qualified LLVM.Core as LLVM
import LLVM.Core (WordN, IntN, )

import qualified Type.Data.Num.Decimal.Number as Dec

import qualified Foreign.Storable.Record.Tuple as StoreTuple
import Foreign.StablePtr (StablePtr, )
import Foreign.Ptr (Ptr, FunPtr, )

import qualified Control.Monad.HT as Monad
import qualified Control.Functor.HT as FuncHT
import Control.Monad (Monad, return, fmap, (>>), )
import Data.Functor (Functor, )

import qualified Data.Tuple.HT as TupleHT
import qualified Data.Tuple as Tup
import qualified Data.EnumBitSet as EnumBitSet
import qualified Data.Enum.Storable as Enum
import qualified Data.Bool8 as Bool8
import Data.Complex (Complex((:+)))
import Data.Tagged (Tagged(Tagged, unTagged))
import Data.Function (id, (.), ($), )
import Data.Maybe (Maybe(Nothing,Just), )
import Data.Bool (Bool(False,True), )
import Data.Word (Word8, Word16, Word32, Word64, Word)
import Data.Int (Int8, Int16, Int32, Int64, Int)
import Data.Bool8 (Bool8)

import qualified Prelude as P
import Prelude (Float, Double, Integer, Rational, )


newtype T a = Cons (Repr a)


class C a where
   type Repr a
   cons :: a -> T a
   undef :: T a
   zero :: T a
   phi :: LLVM.BasicBlock -> T a -> LLVM.CodeGenFunction r (T a)
   addPhi :: LLVM.BasicBlock -> T a -> T a -> LLVM.CodeGenFunction r ()

instance C Bool where
   type Repr Bool = LLVM.Value Bool
   cons :: Bool -> T Bool
cons = Bool -> T Bool
forall al a. (IsConst al, Value al ~ Repr a) => al -> T a
consPrimitive
   undef :: T Bool
undef = T Bool
forall al a. (IsType al, Value al ~ Repr a) => T a
undefPrimitive
   zero :: T Bool
zero = T Bool
forall al a. (IsType al, Value al ~ Repr a) => T a
zeroPrimitive
   phi :: forall r. BasicBlock -> T Bool -> CodeGenFunction r (T Bool)
phi = BasicBlock -> T Bool -> CodeGenFunction r (T Bool)
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> CodeGenFunction r (T a)
phiPrimitive
   addPhi :: forall r. BasicBlock -> T Bool -> T Bool -> CodeGenFunction r ()
addPhi = BasicBlock -> T Bool -> T Bool -> CodeGenFunction r ()
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhiPrimitive

instance C Float where
   type Repr Float = LLVM.Value Float
   cons :: Float -> T Float
cons = Float -> T Float
forall al a. (IsConst al, Value al ~ Repr a) => al -> T a
consPrimitive
   undef :: T Float
undef = T Float
forall al a. (IsType al, Value al ~ Repr a) => T a
undefPrimitive
   zero :: T Float
zero = T Float
forall al a. (IsType al, Value al ~ Repr a) => T a
zeroPrimitive
   phi :: forall r. BasicBlock -> T Float -> CodeGenFunction r (T Float)
phi = BasicBlock -> T Float -> CodeGenFunction r (T Float)
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> CodeGenFunction r (T a)
phiPrimitive
   addPhi :: forall r. BasicBlock -> T Float -> T Float -> CodeGenFunction r ()
addPhi = BasicBlock -> T Float -> T Float -> CodeGenFunction r ()
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhiPrimitive

instance C Double where
   type Repr Double = LLVM.Value Double
   cons :: Double -> T Double
cons = Double -> T Double
forall al a. (IsConst al, Value al ~ Repr a) => al -> T a
consPrimitive
   undef :: T Double
undef = T Double
forall al a. (IsType al, Value al ~ Repr a) => T a
undefPrimitive
   zero :: T Double
zero = T Double
forall al a. (IsType al, Value al ~ Repr a) => T a
zeroPrimitive
   phi :: forall r. BasicBlock -> T Double -> CodeGenFunction r (T Double)
phi = BasicBlock -> T Double -> CodeGenFunction r (T Double)
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> CodeGenFunction r (T a)
phiPrimitive
   addPhi :: forall r.
BasicBlock -> T Double -> T Double -> CodeGenFunction r ()
addPhi = BasicBlock -> T Double -> T Double -> CodeGenFunction r ()
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhiPrimitive

instance C Word where
   type Repr Word = LLVM.Value Word
   cons :: Word -> T Word
cons = Word -> T Word
forall al a. (IsConst al, Value al ~ Repr a) => al -> T a
consPrimitive
   undef :: T Word
undef = T Word
forall al a. (IsType al, Value al ~ Repr a) => T a
undefPrimitive
   zero :: T Word
zero = T Word
forall al a. (IsType al, Value al ~ Repr a) => T a
zeroPrimitive
   phi :: forall r. BasicBlock -> T Word -> CodeGenFunction r (T Word)
phi = BasicBlock -> T Word -> CodeGenFunction r (T Word)
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> CodeGenFunction r (T a)
phiPrimitive
   addPhi :: forall r. BasicBlock -> T Word -> T Word -> CodeGenFunction r ()
addPhi = BasicBlock -> T Word -> T Word -> CodeGenFunction r ()
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhiPrimitive

instance C Word8 where
   type Repr Word8 = LLVM.Value Word8
   cons :: Word8 -> T Word8
cons = Word8 -> T Word8
forall al a. (IsConst al, Value al ~ Repr a) => al -> T a
consPrimitive
   undef :: T Word8
undef = T Word8
forall al a. (IsType al, Value al ~ Repr a) => T a
undefPrimitive
   zero :: T Word8
zero = T Word8
forall al a. (IsType al, Value al ~ Repr a) => T a
zeroPrimitive
   phi :: forall r. BasicBlock -> T Word8 -> CodeGenFunction r (T Word8)
phi = BasicBlock -> T Word8 -> CodeGenFunction r (T Word8)
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> CodeGenFunction r (T a)
phiPrimitive
   addPhi :: forall r. BasicBlock -> T Word8 -> T Word8 -> CodeGenFunction r ()
addPhi = BasicBlock -> T Word8 -> T Word8 -> CodeGenFunction r ()
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhiPrimitive

instance C Word16 where
   type Repr Word16 = LLVM.Value Word16
   cons :: Word16 -> T Word16
cons = Word16 -> T Word16
forall al a. (IsConst al, Value al ~ Repr a) => al -> T a
consPrimitive
   undef :: T Word16
undef = T Word16
forall al a. (IsType al, Value al ~ Repr a) => T a
undefPrimitive
   zero :: T Word16
zero = T Word16
forall al a. (IsType al, Value al ~ Repr a) => T a
zeroPrimitive
   phi :: forall r. BasicBlock -> T Word16 -> CodeGenFunction r (T Word16)
phi = BasicBlock -> T Word16 -> CodeGenFunction r (T Word16)
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> CodeGenFunction r (T a)
phiPrimitive
   addPhi :: forall r.
BasicBlock -> T Word16 -> T Word16 -> CodeGenFunction r ()
addPhi = BasicBlock -> T Word16 -> T Word16 -> CodeGenFunction r ()
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhiPrimitive

instance C Word32 where
   type Repr Word32 = LLVM.Value Word32
   cons :: Word32 -> T Word32
cons = Word32 -> T Word32
forall al a. (IsConst al, Value al ~ Repr a) => al -> T a
consPrimitive
   undef :: T Word32
undef = T Word32
forall al a. (IsType al, Value al ~ Repr a) => T a
undefPrimitive
   zero :: T Word32
zero = T Word32
forall al a. (IsType al, Value al ~ Repr a) => T a
zeroPrimitive
   phi :: forall r. BasicBlock -> T Word32 -> CodeGenFunction r (T Word32)
phi = BasicBlock -> T Word32 -> CodeGenFunction r (T Word32)
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> CodeGenFunction r (T a)
phiPrimitive
   addPhi :: forall r.
BasicBlock -> T Word32 -> T Word32 -> CodeGenFunction r ()
addPhi = BasicBlock -> T Word32 -> T Word32 -> CodeGenFunction r ()
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhiPrimitive

instance C Word64 where
   type Repr Word64 = LLVM.Value Word64
   cons :: Word64 -> T Word64
cons = Word64 -> T Word64
forall al a. (IsConst al, Value al ~ Repr a) => al -> T a
consPrimitive
   undef :: T Word64
undef = T Word64
forall al a. (IsType al, Value al ~ Repr a) => T a
undefPrimitive
   zero :: T Word64
zero = T Word64
forall al a. (IsType al, Value al ~ Repr a) => T a
zeroPrimitive
   phi :: forall r. BasicBlock -> T Word64 -> CodeGenFunction r (T Word64)
phi = BasicBlock -> T Word64 -> CodeGenFunction r (T Word64)
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> CodeGenFunction r (T a)
phiPrimitive
   addPhi :: forall r.
BasicBlock -> T Word64 -> T Word64 -> CodeGenFunction r ()
addPhi = BasicBlock -> T Word64 -> T Word64 -> CodeGenFunction r ()
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhiPrimitive

instance (Dec.Positive n) => C (LLVM.WordN n) where
   type Repr (LLVM.WordN n) = LLVM.Value (LLVM.WordN n)
   cons :: WordN n -> T (WordN n)
cons = WordN n -> T (WordN n)
forall al a. (IsConst al, Value al ~ Repr a) => al -> T a
consPrimitive
   undef :: T (WordN n)
undef = T (WordN n)
forall al a. (IsType al, Value al ~ Repr a) => T a
undefPrimitive
   zero :: T (WordN n)
zero = T (WordN n)
forall al a. (IsType al, Value al ~ Repr a) => T a
zeroPrimitive
   phi :: forall r.
BasicBlock -> T (WordN n) -> CodeGenFunction r (T (WordN n))
phi = BasicBlock -> T (WordN n) -> CodeGenFunction r (T (WordN n))
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> CodeGenFunction r (T a)
phiPrimitive
   addPhi :: forall r.
BasicBlock -> T (WordN n) -> T (WordN n) -> CodeGenFunction r ()
addPhi = BasicBlock -> T (WordN n) -> T (WordN n) -> CodeGenFunction r ()
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhiPrimitive

instance C Int where
   type Repr Int = LLVM.Value Int
   cons :: Int -> T Int
cons = Int -> T Int
forall al a. (IsConst al, Value al ~ Repr a) => al -> T a
consPrimitive
   undef :: T Int
undef = T Int
forall al a. (IsType al, Value al ~ Repr a) => T a
undefPrimitive
   zero :: T Int
zero = T Int
forall al a. (IsType al, Value al ~ Repr a) => T a
zeroPrimitive
   phi :: forall r. BasicBlock -> T Int -> CodeGenFunction r (T Int)
phi = BasicBlock -> T Int -> CodeGenFunction r (T Int)
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> CodeGenFunction r (T a)
phiPrimitive
   addPhi :: forall r. BasicBlock -> T Int -> T Int -> CodeGenFunction r ()
addPhi = BasicBlock -> T Int -> T Int -> CodeGenFunction r ()
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhiPrimitive

instance C Int8 where
   type Repr Int8 = LLVM.Value Int8
   cons :: Int8 -> T Int8
cons = Int8 -> T Int8
forall al a. (IsConst al, Value al ~ Repr a) => al -> T a
consPrimitive
   undef :: T Int8
undef = T Int8
forall al a. (IsType al, Value al ~ Repr a) => T a
undefPrimitive
   zero :: T Int8
zero = T Int8
forall al a. (IsType al, Value al ~ Repr a) => T a
zeroPrimitive
   phi :: forall r. BasicBlock -> T Int8 -> CodeGenFunction r (T Int8)
phi = BasicBlock -> T Int8 -> CodeGenFunction r (T Int8)
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> CodeGenFunction r (T a)
phiPrimitive
   addPhi :: forall r. BasicBlock -> T Int8 -> T Int8 -> CodeGenFunction r ()
addPhi = BasicBlock -> T Int8 -> T Int8 -> CodeGenFunction r ()
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhiPrimitive

instance C Int16 where
   type Repr Int16 = LLVM.Value Int16
   cons :: Int16 -> T Int16
cons = Int16 -> T Int16
forall al a. (IsConst al, Value al ~ Repr a) => al -> T a
consPrimitive
   undef :: T Int16
undef = T Int16
forall al a. (IsType al, Value al ~ Repr a) => T a
undefPrimitive
   zero :: T Int16
zero = T Int16
forall al a. (IsType al, Value al ~ Repr a) => T a
zeroPrimitive
   phi :: forall r. BasicBlock -> T Int16 -> CodeGenFunction r (T Int16)
phi = BasicBlock -> T Int16 -> CodeGenFunction r (T Int16)
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> CodeGenFunction r (T a)
phiPrimitive
   addPhi :: forall r. BasicBlock -> T Int16 -> T Int16 -> CodeGenFunction r ()
addPhi = BasicBlock -> T Int16 -> T Int16 -> CodeGenFunction r ()
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhiPrimitive

instance C Int32 where
   type Repr Int32 = LLVM.Value Int32
   cons :: Int32 -> T Int32
cons = Int32 -> T Int32
forall al a. (IsConst al, Value al ~ Repr a) => al -> T a
consPrimitive
   undef :: T Int32
undef = T Int32
forall al a. (IsType al, Value al ~ Repr a) => T a
undefPrimitive
   zero :: T Int32
zero = T Int32
forall al a. (IsType al, Value al ~ Repr a) => T a
zeroPrimitive
   phi :: forall r. BasicBlock -> T Int32 -> CodeGenFunction r (T Int32)
phi = BasicBlock -> T Int32 -> CodeGenFunction r (T Int32)
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> CodeGenFunction r (T a)
phiPrimitive
   addPhi :: forall r. BasicBlock -> T Int32 -> T Int32 -> CodeGenFunction r ()
addPhi = BasicBlock -> T Int32 -> T Int32 -> CodeGenFunction r ()
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhiPrimitive

instance C Int64 where
   type Repr Int64 = LLVM.Value Int64
   cons :: Int64 -> T Int64
cons = Int64 -> T Int64
forall al a. (IsConst al, Value al ~ Repr a) => al -> T a
consPrimitive
   undef :: T Int64
undef = T Int64
forall al a. (IsType al, Value al ~ Repr a) => T a
undefPrimitive
   zero :: T Int64
zero = T Int64
forall al a. (IsType al, Value al ~ Repr a) => T a
zeroPrimitive
   phi :: forall r. BasicBlock -> T Int64 -> CodeGenFunction r (T Int64)
phi = BasicBlock -> T Int64 -> CodeGenFunction r (T Int64)
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> CodeGenFunction r (T a)
phiPrimitive
   addPhi :: forall r. BasicBlock -> T Int64 -> T Int64 -> CodeGenFunction r ()
addPhi = BasicBlock -> T Int64 -> T Int64 -> CodeGenFunction r ()
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhiPrimitive

instance (Dec.Positive n) => C (LLVM.IntN n) where
   type Repr (LLVM.IntN n) = LLVM.Value (LLVM.IntN n)
   cons :: IntN n -> T (IntN n)
cons = IntN n -> T (IntN n)
forall al a. (IsConst al, Value al ~ Repr a) => al -> T a
consPrimitive
   undef :: T (IntN n)
undef = T (IntN n)
forall al a. (IsType al, Value al ~ Repr a) => T a
undefPrimitive
   zero :: T (IntN n)
zero = T (IntN n)
forall al a. (IsType al, Value al ~ Repr a) => T a
zeroPrimitive
   phi :: forall r.
BasicBlock -> T (IntN n) -> CodeGenFunction r (T (IntN n))
phi = BasicBlock -> T (IntN n) -> CodeGenFunction r (T (IntN n))
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> CodeGenFunction r (T a)
phiPrimitive
   addPhi :: forall r.
BasicBlock -> T (IntN n) -> T (IntN n) -> CodeGenFunction r ()
addPhi = BasicBlock -> T (IntN n) -> T (IntN n) -> CodeGenFunction r ()
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhiPrimitive

instance (LLVM.IsType a) => C (LLVM.Ptr a) where
   type Repr (LLVM.Ptr a) = LLVM.Value (LLVM.Ptr a)
   cons :: Ptr a -> T (Ptr a)
cons = Ptr a -> T (Ptr a)
forall al a. (IsConst al, Value al ~ Repr a) => al -> T a
consPrimitive
   undef :: T (Ptr a)
undef = T (Ptr a)
forall al a. (IsType al, Value al ~ Repr a) => T a
undefPrimitive
   zero :: T (Ptr a)
zero = T (Ptr a)
forall al a. (IsType al, Value al ~ Repr a) => T a
zeroPrimitive
   phi :: forall r. BasicBlock -> T (Ptr a) -> CodeGenFunction r (T (Ptr a))
phi = BasicBlock -> T (Ptr a) -> CodeGenFunction r (T (Ptr a))
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> CodeGenFunction r (T a)
phiPrimitive
   addPhi :: forall r.
BasicBlock -> T (Ptr a) -> T (Ptr a) -> CodeGenFunction r ()
addPhi = BasicBlock -> T (Ptr a) -> T (Ptr a) -> CodeGenFunction r ()
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhiPrimitive

instance C (Ptr a) where
   type Repr (Ptr a) = LLVM.Value (Ptr a)
   cons :: Ptr a -> T (Ptr a)
cons = Ptr a -> T (Ptr a)
forall al a. (IsConst al, Value al ~ Repr a) => al -> T a
consPrimitive
   undef :: T (Ptr a)
undef = T (Ptr a)
forall al a. (IsType al, Value al ~ Repr a) => T a
undefPrimitive
   zero :: T (Ptr a)
zero = T (Ptr a)
forall al a. (IsType al, Value al ~ Repr a) => T a
zeroPrimitive
   phi :: forall r. BasicBlock -> T (Ptr a) -> CodeGenFunction r (T (Ptr a))
phi = BasicBlock -> T (Ptr a) -> CodeGenFunction r (T (Ptr a))
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> CodeGenFunction r (T a)
phiPrimitive
   addPhi :: forall r.
BasicBlock -> T (Ptr a) -> T (Ptr a) -> CodeGenFunction r ()
addPhi = BasicBlock -> T (Ptr a) -> T (Ptr a) -> CodeGenFunction r ()
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhiPrimitive

instance (LLVM.IsFunction a) => C (FunPtr a) where
   type Repr (FunPtr a) = LLVM.Value (FunPtr a)
   cons :: FunPtr a -> T (FunPtr a)
cons = FunPtr a -> T (FunPtr a)
forall al a. (IsConst al, Value al ~ Repr a) => al -> T a
consPrimitive
   undef :: T (FunPtr a)
undef = T (FunPtr a)
forall al a. (IsType al, Value al ~ Repr a) => T a
undefPrimitive
   zero :: T (FunPtr a)
zero = T (FunPtr a)
forall al a. (IsType al, Value al ~ Repr a) => T a
zeroPrimitive
   phi :: forall r.
BasicBlock -> T (FunPtr a) -> CodeGenFunction r (T (FunPtr a))
phi = BasicBlock -> T (FunPtr a) -> CodeGenFunction r (T (FunPtr a))
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> CodeGenFunction r (T a)
phiPrimitive
   addPhi :: forall r.
BasicBlock -> T (FunPtr a) -> T (FunPtr a) -> CodeGenFunction r ()
addPhi = BasicBlock -> T (FunPtr a) -> T (FunPtr a) -> CodeGenFunction r ()
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhiPrimitive

instance C (StablePtr a) where
   type Repr (StablePtr a) = LLVM.Value (StablePtr a)
   cons :: StablePtr a -> T (StablePtr a)
cons = StablePtr a -> T (StablePtr a)
forall al a. (IsConst al, Value al ~ Repr a) => al -> T a
consPrimitive
   undef :: T (StablePtr a)
undef = T (StablePtr a)
forall al a. (IsType al, Value al ~ Repr a) => T a
undefPrimitive
   zero :: T (StablePtr a)
zero = T (StablePtr a)
forall al a. (IsType al, Value al ~ Repr a) => T a
zeroPrimitive
   phi :: forall r.
BasicBlock
-> T (StablePtr a) -> CodeGenFunction r (T (StablePtr a))
phi = BasicBlock
-> T (StablePtr a) -> CodeGenFunction r (T (StablePtr a))
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> CodeGenFunction r (T a)
phiPrimitive
   addPhi :: forall r.
BasicBlock
-> T (StablePtr a) -> T (StablePtr a) -> CodeGenFunction r ()
addPhi = BasicBlock
-> T (StablePtr a) -> T (StablePtr a) -> CodeGenFunction r ()
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhiPrimitive


cast :: (Repr a ~ Repr b) => T a -> T b
cast :: forall a b. (Repr a ~ Repr b) => T a -> T b
cast (Cons Repr a
a) = Repr b -> T b
forall a. Repr a -> T a
Cons Repr a
Repr b
a


consPrimitive ::
   (LLVM.IsConst al, LLVM.Value al ~ Repr a) =>
   al -> T a
consPrimitive :: forall al a. (IsConst al, Value al ~ Repr a) => al -> T a
consPrimitive = Value al -> T a
Repr a -> T a
forall a. Repr a -> T a
Cons (Value al -> T a) -> (al -> Value al) -> al -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. al -> Value al
forall a. IsConst a => a -> Value a
LLVM.valueOf

undefPrimitive, zeroPrimitive ::
   (LLVM.IsType al, LLVM.Value al ~ Repr a) =>
   T a
undefPrimitive :: forall al a. (IsType al, Value al ~ Repr a) => T a
undefPrimitive = Repr a -> T a
forall a. Repr a -> T a
Cons (Repr a -> T a) -> Repr a -> T a
forall a b. (a -> b) -> a -> b
$ ConstValue al -> Value al
forall a. ConstValue a -> Value a
LLVM.value ConstValue al
forall a. IsType a => ConstValue a
LLVM.undef
zeroPrimitive :: forall al a. (IsType al, Value al ~ Repr a) => T a
zeroPrimitive = Repr a -> T a
forall a. Repr a -> T a
Cons (Repr a -> T a) -> Repr a -> T a
forall a b. (a -> b) -> a -> b
$ ConstValue al -> Value al
forall a. ConstValue a -> Value a
LLVM.value ConstValue al
forall a. IsType a => ConstValue a
LLVM.zero

phiPrimitive ::
   (LLVM.IsFirstClass al, LLVM.Value al ~ Repr a) =>
   LLVM.BasicBlock -> T a -> LLVM.CodeGenFunction r (T a)
phiPrimitive :: forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> CodeGenFunction r (T a)
phiPrimitive BasicBlock
bb (Cons Repr a
a) = (Value al -> T a)
-> CodeGenFunction r (Value al) -> CodeGenFunction r (T a)
forall a b. (a -> b) -> CodeGenFunction r a -> CodeGenFunction r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value al -> T a
Repr a -> T a
forall a. Repr a -> T a
Cons (CodeGenFunction r (Value al) -> CodeGenFunction r (T a))
-> CodeGenFunction r (Value al) -> CodeGenFunction r (T a)
forall a b. (a -> b) -> a -> b
$ BasicBlock -> Value al -> CodeGenFunction r (Value al)
forall r. BasicBlock -> Value al -> CodeGenFunction r (Value al)
forall a r. Phi a => BasicBlock -> a -> CodeGenFunction r a
Tuple.phi BasicBlock
bb Value al
Repr a
a

addPhiPrimitive ::
   (LLVM.IsFirstClass al, LLVM.Value al ~ Repr a) =>
   LLVM.BasicBlock -> T a -> T a -> LLVM.CodeGenFunction r ()
addPhiPrimitive :: forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhiPrimitive BasicBlock
bb (Cons Repr a
a) (Cons Repr a
b) = BasicBlock -> Value al -> Value al -> CodeGenFunction r ()
forall r.
BasicBlock -> Value al -> Value al -> CodeGenFunction r ()
forall a r. Phi a => BasicBlock -> a -> a -> CodeGenFunction r ()
Tuple.addPhi BasicBlock
bb Value al
Repr a
a Value al
Repr a
b


consTuple :: (Tuple.Value a, Repr a ~ Tuple.ValueOf a) => a -> T a
consTuple :: forall a. (Value a, Repr a ~ ValueOf a) => a -> T a
consTuple = ValueOf a -> T a
Repr a -> T a
forall a. Repr a -> T a
Cons (ValueOf a -> T a) -> (a -> ValueOf a) -> a -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ValueOf a
forall a. Value a => a -> ValueOf a
Tuple.valueOf

undefTuple :: (Repr a ~ al, Tuple.Undefined al) => T a
undefTuple :: forall a al. (Repr a ~ al, Undefined al) => T a
undefTuple = Repr a -> T a
forall a. Repr a -> T a
Cons al
Repr a
forall a. Undefined a => a
Tuple.undef

zeroTuple :: (Repr a ~ al, Tuple.Zero al) => T a
zeroTuple :: forall a al. (Repr a ~ al, Zero al) => T a
zeroTuple = Repr a -> T a
forall a. Repr a -> T a
Cons al
Repr a
forall a. Zero a => a
Tuple.zero

phiTuple ::
   (Repr a ~ al, Tuple.Phi al) =>
   LLVM.BasicBlock -> T a -> LLVM.CodeGenFunction r (T a)
phiTuple :: forall a al r.
(Repr a ~ al, Phi al) =>
BasicBlock -> T a -> CodeGenFunction r (T a)
phiTuple BasicBlock
bb (Cons Repr a
a) = (al -> T a) -> CodeGenFunction r al -> CodeGenFunction r (T a)
forall a b. (a -> b) -> CodeGenFunction r a -> CodeGenFunction r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap al -> T a
Repr a -> T a
forall a. Repr a -> T a
Cons (CodeGenFunction r al -> CodeGenFunction r (T a))
-> CodeGenFunction r al -> CodeGenFunction r (T a)
forall a b. (a -> b) -> a -> b
$ BasicBlock -> al -> CodeGenFunction r al
forall r. BasicBlock -> al -> CodeGenFunction r al
forall a r. Phi a => BasicBlock -> a -> CodeGenFunction r a
Tuple.phi BasicBlock
bb al
Repr a
a

addPhiTuple ::
   (Repr a ~ al, Tuple.Phi al) =>
   LLVM.BasicBlock -> T a -> T a -> LLVM.CodeGenFunction r ()
addPhiTuple :: forall a al r.
(Repr a ~ al, Phi al) =>
BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhiTuple BasicBlock
bb (Cons Repr a
a) (Cons Repr a
b) = BasicBlock -> al -> al -> CodeGenFunction r ()
forall r. BasicBlock -> al -> al -> CodeGenFunction r ()
forall a r. Phi a => BasicBlock -> a -> a -> CodeGenFunction r ()
Tuple.addPhi BasicBlock
bb al
Repr a
a al
Repr a
b


instance C () where
   type Repr () = ()
   cons :: () -> T ()
cons = () -> T ()
forall a. (Repr a ~ ()) => a -> T a
consUnit
   undef :: T ()
undef = T ()
forall a. (Repr a ~ ()) => T a
undefUnit
   zero :: T ()
zero = T ()
forall a. (Repr a ~ ()) => T a
zeroUnit
   phi :: forall r. BasicBlock -> T () -> CodeGenFunction r (T ())
phi = BasicBlock -> T () -> CodeGenFunction r (T ())
forall a r.
(Repr a ~ ()) =>
BasicBlock -> T a -> CodeGenFunction r (T a)
phiUnit
   addPhi :: forall r. BasicBlock -> T () -> T () -> CodeGenFunction r ()
addPhi = BasicBlock -> T () -> T () -> CodeGenFunction r ()
forall a r.
(Repr a ~ ()) =>
BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhiUnit

consUnit :: (Repr a ~ ()) => a -> T a
consUnit :: forall a. (Repr a ~ ()) => a -> T a
consUnit a
_ = Repr a -> T a
forall a. Repr a -> T a
Cons ()

undefUnit :: (Repr a ~ ()) => T a
undefUnit :: forall a. (Repr a ~ ()) => T a
undefUnit = Repr a -> T a
forall a. Repr a -> T a
Cons ()

zeroUnit :: (Repr a ~ ()) => T a
zeroUnit :: forall a. (Repr a ~ ()) => T a
zeroUnit = Repr a -> T a
forall a. Repr a -> T a
Cons ()

phiUnit ::
   (Repr a ~ ()) =>
   LLVM.BasicBlock -> T a -> LLVM.CodeGenFunction r (T a)
phiUnit :: forall a r.
(Repr a ~ ()) =>
BasicBlock -> T a -> CodeGenFunction r (T a)
phiUnit BasicBlock
_bb (Cons ()) = T a -> CodeGenFunction r (T a)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (T a -> CodeGenFunction r (T a)) -> T a -> CodeGenFunction r (T a)
forall a b. (a -> b) -> a -> b
$ Repr a -> T a
forall a. Repr a -> T a
Cons ()

addPhiUnit ::
   (Repr a ~ ()) =>
   LLVM.BasicBlock -> T a -> T a -> LLVM.CodeGenFunction r ()
addPhiUnit :: forall a r.
(Repr a ~ ()) =>
BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhiUnit BasicBlock
_bb (Cons ()) (Cons ()) = () -> CodeGenFunction r ()
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


instance C Bool8 where
   type Repr Bool8 = LLVM.Value Bool
   cons :: Bool8 -> T Bool8
cons = Bool -> T Bool8
forall al a. (IsConst al, Value al ~ Repr a) => al -> T a
consPrimitive (Bool -> T Bool8) -> (Bool8 -> Bool) -> Bool8 -> T Bool8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool8 -> Bool
Bool8.toBool
   undef :: T Bool8
undef = T Bool8
forall al a. (IsType al, Value al ~ Repr a) => T a
undefPrimitive
   zero :: T Bool8
zero = T Bool8
forall al a. (IsType al, Value al ~ Repr a) => T a
zeroPrimitive
   phi :: forall r. BasicBlock -> T Bool8 -> CodeGenFunction r (T Bool8)
phi = BasicBlock -> T Bool8 -> CodeGenFunction r (T Bool8)
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> CodeGenFunction r (T a)
phiPrimitive
   addPhi :: forall r. BasicBlock -> T Bool8 -> T Bool8 -> CodeGenFunction r ()
addPhi = BasicBlock -> T Bool8 -> T Bool8 -> CodeGenFunction r ()
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhiPrimitive

boolPFrom8 :: T Bool8 -> T Bool
boolPFrom8 :: T Bool8 -> T Bool
boolPFrom8 (Cons Repr Bool8
b) = Repr Bool -> T Bool
forall a. Repr a -> T a
Cons Repr Bool
Repr Bool8
b

bool8FromP :: T Bool -> T Bool8
bool8FromP :: T Bool -> T Bool8
bool8FromP (Cons Repr Bool
b) = Repr Bool8 -> T Bool8
forall a. Repr a -> T a
Cons Repr Bool
Repr Bool8
b

intFromBool8 :: (NativeInteger i ir) => T Bool8 -> LLVM.CodeGenFunction r (T i)
intFromBool8 :: forall i ir r.
NativeInteger i ir =>
T Bool8 -> CodeGenFunction r (T i)
intFromBool8 = (Repr Bool8 -> CodeGenFunction r (Repr i))
-> T Bool8 -> CodeGenFunction r (T i)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Bool -> CodeGenFunction r (Value ir)
Repr Bool8 -> CodeGenFunction r (Repr i)
forall (value :: * -> *) a b r.
(ValueCons value, IsInteger a, IsInteger b,
 ShapeOf a ~ ShapeOf b) =>
value a -> CodeGenFunction r (value b)
LLVM.zadapt

floatFromBool8 ::
   (NativeFloating a ar) => T Bool8 -> LLVM.CodeGenFunction r (T a)
floatFromBool8 :: forall a ar r.
NativeFloating a ar =>
T Bool8 -> CodeGenFunction r (T a)
floatFromBool8 = (Repr Bool8 -> CodeGenFunction r (Repr a))
-> T Bool8 -> CodeGenFunction r (T a)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Bool -> CodeGenFunction r (Value ar)
Repr Bool8 -> CodeGenFunction r (Repr a)
forall (value :: * -> *) a b r.
(ValueCons value, IsInteger a, IsFloating b,
 ShapeOf a ~ ShapeOf b) =>
value a -> CodeGenFunction r (value b)
LLVM.uitofp


instance
   (LLVM.IsInteger w, LLVM.IsConst w, P.Num w, P.Enum e) =>
      C (Enum.T w e) where
   type Repr (Enum.T w e) = LLVM.Value w
   cons :: T w e -> T (T w e)
cons = w -> T (T w e)
forall al a. (IsConst al, Value al ~ Repr a) => al -> T a
consPrimitive (w -> T (T w e)) -> (T w e -> w) -> T w e -> T (T w e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> w
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> w) -> (T w e -> Int) -> T w e -> w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Int
forall a. Enum a => a -> Int
P.fromEnum (e -> Int) -> (T w e -> e) -> T w e -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T w e -> e
forall w a. T w a -> a
Enum.toPlain
   undef :: T (T w e)
undef = T (T w e)
forall al a. (IsType al, Value al ~ Repr a) => T a
undefPrimitive
   zero :: T (T w e)
zero = T (T w e)
forall al a. (IsType al, Value al ~ Repr a) => T a
zeroPrimitive
   phi :: forall r. BasicBlock -> T (T w e) -> CodeGenFunction r (T (T w e))
phi = BasicBlock -> T (T w e) -> CodeGenFunction r (T (T w e))
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> CodeGenFunction r (T a)
phiPrimitive
   addPhi :: forall r.
BasicBlock -> T (T w e) -> T (T w e) -> CodeGenFunction r ()
addPhi = BasicBlock -> T (T w e) -> T (T w e) -> CodeGenFunction r ()
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhiPrimitive

toEnum ::
   (Repr w ~ LLVM.Value w) =>
   T w -> T (Enum.T w e)
toEnum :: forall w e. (Repr w ~ Value w) => T w -> T (T w e)
toEnum (Cons Repr w
w) = Repr (T w e) -> T (T w e)
forall a. Repr a -> T a
Cons Repr w
Repr (T w e)
w

fromEnum ::
   (Repr w ~ LLVM.Value w) =>
   T (Enum.T w e) -> T w
fromEnum :: forall w e. (Repr w ~ Value w) => T (T w e) -> T w
fromEnum (Cons Repr (T w e)
w) = Repr w -> T w
forall a. Repr a -> T a
Cons Repr w
Repr (T w e)
w

succ, pred ::
   (LLVM.IsArithmetic w, SoV.IntegerConstant w) =>
   T (Enum.T w e) -> LLVM.CodeGenFunction r (T (Enum.T w e))
succ :: forall w e r.
(IsArithmetic w, IntegerConstant w) =>
T (T w e) -> CodeGenFunction r (T (T w e))
succ = (Repr (T w e) -> CodeGenFunction r (Repr (T w e)))
-> T (T w e) -> CodeGenFunction r (T (T w e))
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM ((Repr (T w e) -> CodeGenFunction r (Repr (T w e)))
 -> T (T w e) -> CodeGenFunction r (T (T w e)))
-> (Repr (T w e) -> CodeGenFunction r (Repr (T w e)))
-> T (T w e)
-> CodeGenFunction r (T (T w e))
forall a b. (a -> b) -> a -> b
$ \Repr (T w e)
w -> Value w -> Value w -> CodeGenFunction r (Value w)
forall r. Value w -> Value w -> CodeGenFunction r (Value w)
forall a r. Additive a => a -> a -> CodeGenFunction r a
A.add Value w
Repr (T w e)
w Value w
forall a. IntegerConstant a => a
A.one
pred :: forall w e r.
(IsArithmetic w, IntegerConstant w) =>
T (T w e) -> CodeGenFunction r (T (T w e))
pred = (Repr (T w e) -> CodeGenFunction r (Repr (T w e)))
-> T (T w e) -> CodeGenFunction r (T (T w e))
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM ((Repr (T w e) -> CodeGenFunction r (Repr (T w e)))
 -> T (T w e) -> CodeGenFunction r (T (T w e)))
-> (Repr (T w e) -> CodeGenFunction r (Repr (T w e)))
-> T (T w e)
-> CodeGenFunction r (T (T w e))
forall a b. (a -> b) -> a -> b
$ \Repr (T w e)
w -> Value w -> Value w -> CodeGenFunction r (Value w)
forall r. Value w -> Value w -> CodeGenFunction r (Value w)
forall a r. Additive a => a -> a -> CodeGenFunction r a
A.sub Value w
Repr (T w e)
w Value w
forall a. IntegerConstant a => a
A.one

-- cannot be an instance of 'Comparison' because there is no 'Real' instance
cmpEnum ::
   (LLVM.CmpRet w, LLVM.IsPrimitive w) =>
   LLVM.CmpPredicate -> T (Enum.T w a) -> T (Enum.T w a) ->
   LLVM.CodeGenFunction r (T Bool)
cmpEnum :: forall w a r.
(CmpRet w, IsPrimitive w) =>
CmpPredicate
-> T (T w a) -> T (T w a) -> CodeGenFunction r (T Bool)
cmpEnum = (Value w -> Value w -> CodeGenFunction r (Value Bool))
-> T (T w a) -> T (T w a) -> CodeGenFunction r (T Bool)
(Repr (T w a) -> Repr (T w a) -> CodeGenFunction r (Repr Bool))
-> T (T w a) -> T (T w a) -> CodeGenFunction r (T Bool)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 ((Value w -> Value w -> CodeGenFunction r (Value Bool))
 -> T (T w a) -> T (T w a) -> CodeGenFunction r (T Bool))
-> (CmpPredicate
    -> Value w -> Value w -> CodeGenFunction r (Value Bool))
-> CmpPredicate
-> T (T w a)
-> T (T w a)
-> CodeGenFunction r (T Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmpPredicate
-> Value w -> Value w -> CodeGenFunction r (Value Bool)
CmpPredicate
-> Value w
-> Value w
-> CodeGenFunction r (CmpValueResult Value Value w)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, CmpRet a) =>
CmpPredicate
-> value0 a
-> value1 a
-> CodeGenFunction r (CmpValueResult value0 value1 a)
LLVM.cmp


class (C a) => Bounded a where
   minBound, maxBound :: T a

instance
   (LLVM.IsInteger w, LLVM.IsConst w, P.Num w, P.Enum e, P.Bounded e) =>
      Bounded (Enum.T w e) where
   minBound :: T (T w e)
minBound = T w e -> T (T w e)
forall a. C a => a -> T a
cons T w e
forall a. Bounded a => a
P.minBound
   maxBound :: T (T w e)
maxBound = T w e -> T (T w e)
forall a. C a => a -> T a
cons T w e
forall a. Bounded a => a
P.maxBound


instance (LLVM.IsInteger w, LLVM.IsConst w) => C (EnumBitSet.T w i) where
   type Repr (EnumBitSet.T w i) = LLVM.Value w
   cons :: T w i -> T (T w i)
cons = w -> T (T w i)
forall al a. (IsConst al, Value al ~ Repr a) => al -> T a
consPrimitive (w -> T (T w i)) -> (T w i -> w) -> T w i -> T (T w i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T w i -> w
forall word index. T word index -> word
EnumBitSet.decons
   undef :: T (T w i)
undef = T (T w i)
forall al a. (IsType al, Value al ~ Repr a) => T a
undefPrimitive
   zero :: T (T w i)
zero = T (T w i)
forall al a. (IsType al, Value al ~ Repr a) => T a
zeroPrimitive
   phi :: forall r. BasicBlock -> T (T w i) -> CodeGenFunction r (T (T w i))
phi = BasicBlock -> T (T w i) -> CodeGenFunction r (T (T w i))
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> CodeGenFunction r (T a)
phiPrimitive
   addPhi :: forall r.
BasicBlock -> T (T w i) -> T (T w i) -> CodeGenFunction r ()
addPhi = BasicBlock -> T (T w i) -> T (T w i) -> CodeGenFunction r ()
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhiPrimitive


instance (C a) => C (Maybe a) where
   type Repr (Maybe a) = (LLVM.Value Bool, Repr a)
   cons :: Maybe a -> T (Maybe a)
cons Maybe a
Nothing = T (Maybe a)
forall a. C a => T (Maybe a)
nothing
   cons (Just a
a) = T a -> T (Maybe a)
forall a. T a -> T (Maybe a)
just (T a -> T (Maybe a)) -> T a -> T (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> T a
forall a. C a => a -> T a
cons a
a
   undef :: T (Maybe a)
undef = T Bool -> T a -> T (Maybe a)
forall a. T Bool -> T a -> T (Maybe a)
toMaybe T Bool
forall a. C a => T a
undef T a
forall a. C a => T a
undef
   zero :: T (Maybe a)
zero = T Bool -> T a -> T (Maybe a)
forall a. T Bool -> T a -> T (Maybe a)
toMaybe (Bool -> T Bool
forall a. C a => a -> T a
cons Bool
False) T a
forall a. C a => T a
zero
   phi :: forall r.
BasicBlock -> T (Maybe a) -> CodeGenFunction r (T (Maybe a))
phi BasicBlock
bb T (Maybe a)
ma =
      case T (Maybe a) -> (T Bool, T a)
forall a. T (Maybe a) -> (T Bool, T a)
splitMaybe T (Maybe a)
ma of
         (T Bool
b,T a
a) -> (T Bool -> T a -> T (Maybe a))
-> CodeGenFunction r (T Bool)
-> CodeGenFunction r (T a)
-> CodeGenFunction r (T (Maybe a))
forall (m :: * -> *) a b r.
Monad m =>
(a -> b -> r) -> m a -> m b -> m r
Monad.lift2 T Bool -> T a -> T (Maybe a)
forall a. T Bool -> T a -> T (Maybe a)
toMaybe (BasicBlock -> T Bool -> CodeGenFunction r (T Bool)
forall r. BasicBlock -> T Bool -> CodeGenFunction r (T Bool)
forall a r. C a => BasicBlock -> T a -> CodeGenFunction r (T a)
phi BasicBlock
bb T Bool
b) (BasicBlock -> T a -> CodeGenFunction r (T a)
forall r. BasicBlock -> T a -> CodeGenFunction r (T a)
forall a r. C a => BasicBlock -> T a -> CodeGenFunction r (T a)
phi BasicBlock
bb T a
a)
   addPhi :: forall r.
BasicBlock -> T (Maybe a) -> T (Maybe a) -> CodeGenFunction r ()
addPhi BasicBlock
bb T (Maybe a)
x T (Maybe a)
y =
      case (T (Maybe a) -> (T Bool, T a)
forall a. T (Maybe a) -> (T Bool, T a)
splitMaybe T (Maybe a)
x, T (Maybe a) -> (T Bool, T a)
forall a. T (Maybe a) -> (T Bool, T a)
splitMaybe T (Maybe a)
y) of
         ((T Bool
xb,T a
xa), (T Bool
yb,T a
ya)) ->
            BasicBlock -> T Bool -> T Bool -> CodeGenFunction r ()
forall r. BasicBlock -> T Bool -> T Bool -> CodeGenFunction r ()
forall a r. C a => BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhi BasicBlock
bb T Bool
xb T Bool
yb CodeGenFunction r ()
-> CodeGenFunction r () -> CodeGenFunction r ()
forall a b.
CodeGenFunction r a -> CodeGenFunction r b -> CodeGenFunction r b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
            BasicBlock -> T a -> T a -> CodeGenFunction r ()
forall r. BasicBlock -> T a -> T a -> CodeGenFunction r ()
forall a r. C a => BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhi BasicBlock
bb T a
xa T a
ya

splitMaybe :: T (Maybe a) -> (T Bool, T a)
splitMaybe :: forall a. T (Maybe a) -> (T Bool, T a)
splitMaybe (Cons (Value Bool
b,Repr a
a)) = (Repr Bool -> T Bool
forall a. Repr a -> T a
Cons Value Bool
Repr Bool
b, Repr a -> T a
forall a. Repr a -> T a
Cons Repr a
a)

toMaybe :: T Bool -> T a -> T (Maybe a)
toMaybe :: forall a. T Bool -> T a -> T (Maybe a)
toMaybe (Cons Repr Bool
b) (Cons Repr a
a) = Repr (Maybe a) -> T (Maybe a)
forall a. Repr a -> T a
Cons (Value Bool
Repr Bool
b,Repr a
a)

nothing :: (C a) => T (Maybe a)
nothing :: forall a. C a => T (Maybe a)
nothing = T Bool -> T a -> T (Maybe a)
forall a. T Bool -> T a -> T (Maybe a)
toMaybe (Bool -> T Bool
forall a. C a => a -> T a
cons Bool
False) T a
forall a. C a => T a
undef

just :: T a -> T (Maybe a)
just :: forall a. T a -> T (Maybe a)
just = T Bool -> T a -> T (Maybe a)
forall a. T Bool -> T a -> T (Maybe a)
toMaybe (Bool -> T Bool
forall a. C a => a -> T a
cons Bool
True)


instance (C a, C b) => C (a,b) where
   type Repr (a, b) = (Repr a, Repr b)
   cons :: (a, b) -> T (a, b)
cons (a
a,b
b) = T a -> T b -> T (a, b)
forall a b. T a -> T b -> T (a, b)
zip (a -> T a
forall a. C a => a -> T a
cons a
a) (b -> T b
forall a. C a => a -> T a
cons b
b)
   undef :: T (a, b)
undef = T a -> T b -> T (a, b)
forall a b. T a -> T b -> T (a, b)
zip T a
forall a. C a => T a
undef T b
forall a. C a => T a
undef
   zero :: T (a, b)
zero = T a -> T b -> T (a, b)
forall a b. T a -> T b -> T (a, b)
zip T a
forall a. C a => T a
zero T b
forall a. C a => T a
zero
   phi :: forall r. BasicBlock -> T (a, b) -> CodeGenFunction r (T (a, b))
phi BasicBlock
bb T (a, b)
a =
      case T (a, b) -> (T a, T b)
forall a b. T (a, b) -> (T a, T b)
unzip T (a, b)
a of
         (T a
a0,T b
a1) ->
            (T a -> T b -> T (a, b))
-> CodeGenFunction r (T a)
-> CodeGenFunction r (T b)
-> CodeGenFunction r (T (a, b))
forall (m :: * -> *) a b r.
Monad m =>
(a -> b -> r) -> m a -> m b -> m r
Monad.lift2 T a -> T b -> T (a, b)
forall a b. T a -> T b -> T (a, b)
zip (BasicBlock -> T a -> CodeGenFunction r (T a)
forall r. BasicBlock -> T a -> CodeGenFunction r (T a)
forall a r. C a => BasicBlock -> T a -> CodeGenFunction r (T a)
phi BasicBlock
bb T a
a0) (BasicBlock -> T b -> CodeGenFunction r (T b)
forall r. BasicBlock -> T b -> CodeGenFunction r (T b)
forall a r. C a => BasicBlock -> T a -> CodeGenFunction r (T a)
phi BasicBlock
bb T b
a1)
   addPhi :: forall r.
BasicBlock -> T (a, b) -> T (a, b) -> CodeGenFunction r ()
addPhi BasicBlock
bb T (a, b)
a T (a, b)
b =
      case (T (a, b) -> (T a, T b)
forall a b. T (a, b) -> (T a, T b)
unzip T (a, b)
a, T (a, b) -> (T a, T b)
forall a b. T (a, b) -> (T a, T b)
unzip T (a, b)
b) of
         ((T a
a0,T b
a1), (T a
b0,T b
b1)) ->
            BasicBlock -> T a -> T a -> CodeGenFunction r ()
forall r. BasicBlock -> T a -> T a -> CodeGenFunction r ()
forall a r. C a => BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhi BasicBlock
bb T a
a0 T a
b0 CodeGenFunction r ()
-> CodeGenFunction r () -> CodeGenFunction r ()
forall a b.
CodeGenFunction r a -> CodeGenFunction r b -> CodeGenFunction r b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
            BasicBlock -> T b -> T b -> CodeGenFunction r ()
forall r. BasicBlock -> T b -> T b -> CodeGenFunction r ()
forall a r. C a => BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhi BasicBlock
bb T b
a1 T b
b1

instance (C a, C b, C c) => C (a,b,c) where
   type Repr (a, b, c) = (Repr a, Repr b, Repr c)
   cons :: (a, b, c) -> T (a, b, c)
cons (a
a,b
b,c
c) = T a -> T b -> T c -> T (a, b, c)
forall a b c. T a -> T b -> T c -> T (a, b, c)
zip3 (a -> T a
forall a. C a => a -> T a
cons a
a) (b -> T b
forall a. C a => a -> T a
cons b
b) (c -> T c
forall a. C a => a -> T a
cons c
c)
   undef :: T (a, b, c)
undef = T a -> T b -> T c -> T (a, b, c)
forall a b c. T a -> T b -> T c -> T (a, b, c)
zip3 T a
forall a. C a => T a
undef T b
forall a. C a => T a
undef T c
forall a. C a => T a
undef
   zero :: T (a, b, c)
zero = T a -> T b -> T c -> T (a, b, c)
forall a b c. T a -> T b -> T c -> T (a, b, c)
zip3 T a
forall a. C a => T a
zero T b
forall a. C a => T a
zero T c
forall a. C a => T a
zero
   phi :: forall r.
BasicBlock -> T (a, b, c) -> CodeGenFunction r (T (a, b, c))
phi BasicBlock
bb T (a, b, c)
a =
      case T (a, b, c) -> (T a, T b, T c)
forall a b c. T (a, b, c) -> (T a, T b, T c)
unzip3 T (a, b, c)
a of
         (T a
a0,T b
a1,T c
a2) ->
            (T a -> T b -> T c -> T (a, b, c))
-> CodeGenFunction r (T a)
-> CodeGenFunction r (T b)
-> CodeGenFunction r (T c)
-> CodeGenFunction r (T (a, b, c))
forall (m :: * -> *) a b c r.
Monad m =>
(a -> b -> c -> r) -> m a -> m b -> m c -> m r
Monad.lift3 T a -> T b -> T c -> T (a, b, c)
forall a b c. T a -> T b -> T c -> T (a, b, c)
zip3 (BasicBlock -> T a -> CodeGenFunction r (T a)
forall r. BasicBlock -> T a -> CodeGenFunction r (T a)
forall a r. C a => BasicBlock -> T a -> CodeGenFunction r (T a)
phi BasicBlock
bb T a
a0) (BasicBlock -> T b -> CodeGenFunction r (T b)
forall r. BasicBlock -> T b -> CodeGenFunction r (T b)
forall a r. C a => BasicBlock -> T a -> CodeGenFunction r (T a)
phi BasicBlock
bb T b
a1) (BasicBlock -> T c -> CodeGenFunction r (T c)
forall r. BasicBlock -> T c -> CodeGenFunction r (T c)
forall a r. C a => BasicBlock -> T a -> CodeGenFunction r (T a)
phi BasicBlock
bb T c
a2)
   addPhi :: forall r.
BasicBlock -> T (a, b, c) -> T (a, b, c) -> CodeGenFunction r ()
addPhi BasicBlock
bb T (a, b, c)
a T (a, b, c)
b =
      case (T (a, b, c) -> (T a, T b, T c)
forall a b c. T (a, b, c) -> (T a, T b, T c)
unzip3 T (a, b, c)
a, T (a, b, c) -> (T a, T b, T c)
forall a b c. T (a, b, c) -> (T a, T b, T c)
unzip3 T (a, b, c)
b) of
         ((T a
a0,T b
a1,T c
a2), (T a
b0,T b
b1,T c
b2)) ->
            BasicBlock -> T a -> T a -> CodeGenFunction r ()
forall r. BasicBlock -> T a -> T a -> CodeGenFunction r ()
forall a r. C a => BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhi BasicBlock
bb T a
a0 T a
b0 CodeGenFunction r ()
-> CodeGenFunction r () -> CodeGenFunction r ()
forall a b.
CodeGenFunction r a -> CodeGenFunction r b -> CodeGenFunction r b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
            BasicBlock -> T b -> T b -> CodeGenFunction r ()
forall r. BasicBlock -> T b -> T b -> CodeGenFunction r ()
forall a r. C a => BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhi BasicBlock
bb T b
a1 T b
b1 CodeGenFunction r ()
-> CodeGenFunction r () -> CodeGenFunction r ()
forall a b.
CodeGenFunction r a -> CodeGenFunction r b -> CodeGenFunction r b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
            BasicBlock -> T c -> T c -> CodeGenFunction r ()
forall r. BasicBlock -> T c -> T c -> CodeGenFunction r ()
forall a r. C a => BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhi BasicBlock
bb T c
a2 T c
b2

instance (C a, C b, C c, C d) => C (a,b,c,d) where
   type Repr (a, b, c, d) = (Repr a, Repr b, Repr c, Repr d)
   cons :: (a, b, c, d) -> T (a, b, c, d)
cons (a
a,b
b,c
c,d
d) = T a -> T b -> T c -> T d -> T (a, b, c, d)
forall a b c d. T a -> T b -> T c -> T d -> T (a, b, c, d)
zip4 (a -> T a
forall a. C a => a -> T a
cons a
a) (b -> T b
forall a. C a => a -> T a
cons b
b) (c -> T c
forall a. C a => a -> T a
cons c
c) (d -> T d
forall a. C a => a -> T a
cons d
d)
   undef :: T (a, b, c, d)
undef = T a -> T b -> T c -> T d -> T (a, b, c, d)
forall a b c d. T a -> T b -> T c -> T d -> T (a, b, c, d)
zip4 T a
forall a. C a => T a
undef T b
forall a. C a => T a
undef T c
forall a. C a => T a
undef T d
forall a. C a => T a
undef
   zero :: T (a, b, c, d)
zero = T a -> T b -> T c -> T d -> T (a, b, c, d)
forall a b c d. T a -> T b -> T c -> T d -> T (a, b, c, d)
zip4 T a
forall a. C a => T a
zero T b
forall a. C a => T a
zero T c
forall a. C a => T a
zero T d
forall a. C a => T a
zero
   phi :: forall r.
BasicBlock -> T (a, b, c, d) -> CodeGenFunction r (T (a, b, c, d))
phi BasicBlock
bb T (a, b, c, d)
a =
      case T (a, b, c, d) -> (T a, T b, T c, T d)
forall a b c d. T (a, b, c, d) -> (T a, T b, T c, T d)
unzip4 T (a, b, c, d)
a of
         (T a
a0,T b
a1,T c
a2,T d
a3) ->
            (T a -> T b -> T c -> T d -> T (a, b, c, d))
-> CodeGenFunction r (T a)
-> CodeGenFunction r (T b)
-> CodeGenFunction r (T c)
-> CodeGenFunction r (T d)
-> CodeGenFunction r (T (a, b, c, d))
forall (m :: * -> *) a b c d r.
Monad m =>
(a -> b -> c -> d -> r) -> m a -> m b -> m c -> m d -> m r
Monad.lift4 T a -> T b -> T c -> T d -> T (a, b, c, d)
forall a b c d. T a -> T b -> T c -> T d -> T (a, b, c, d)
zip4 (BasicBlock -> T a -> CodeGenFunction r (T a)
forall r. BasicBlock -> T a -> CodeGenFunction r (T a)
forall a r. C a => BasicBlock -> T a -> CodeGenFunction r (T a)
phi BasicBlock
bb T a
a0) (BasicBlock -> T b -> CodeGenFunction r (T b)
forall r. BasicBlock -> T b -> CodeGenFunction r (T b)
forall a r. C a => BasicBlock -> T a -> CodeGenFunction r (T a)
phi BasicBlock
bb T b
a1) (BasicBlock -> T c -> CodeGenFunction r (T c)
forall r. BasicBlock -> T c -> CodeGenFunction r (T c)
forall a r. C a => BasicBlock -> T a -> CodeGenFunction r (T a)
phi BasicBlock
bb T c
a2) (BasicBlock -> T d -> CodeGenFunction r (T d)
forall r. BasicBlock -> T d -> CodeGenFunction r (T d)
forall a r. C a => BasicBlock -> T a -> CodeGenFunction r (T a)
phi BasicBlock
bb T d
a3)
   addPhi :: forall r.
BasicBlock
-> T (a, b, c, d) -> T (a, b, c, d) -> CodeGenFunction r ()
addPhi BasicBlock
bb T (a, b, c, d)
a T (a, b, c, d)
b =
      case (T (a, b, c, d) -> (T a, T b, T c, T d)
forall a b c d. T (a, b, c, d) -> (T a, T b, T c, T d)
unzip4 T (a, b, c, d)
a, T (a, b, c, d) -> (T a, T b, T c, T d)
forall a b c d. T (a, b, c, d) -> (T a, T b, T c, T d)
unzip4 T (a, b, c, d)
b) of
         ((T a
a0,T b
a1,T c
a2,T d
a3), (T a
b0,T b
b1,T c
b2,T d
b3)) ->
            BasicBlock -> T a -> T a -> CodeGenFunction r ()
forall r. BasicBlock -> T a -> T a -> CodeGenFunction r ()
forall a r. C a => BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhi BasicBlock
bb T a
a0 T a
b0 CodeGenFunction r ()
-> CodeGenFunction r () -> CodeGenFunction r ()
forall a b.
CodeGenFunction r a -> CodeGenFunction r b -> CodeGenFunction r b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
            BasicBlock -> T b -> T b -> CodeGenFunction r ()
forall r. BasicBlock -> T b -> T b -> CodeGenFunction r ()
forall a r. C a => BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhi BasicBlock
bb T b
a1 T b
b1 CodeGenFunction r ()
-> CodeGenFunction r () -> CodeGenFunction r ()
forall a b.
CodeGenFunction r a -> CodeGenFunction r b -> CodeGenFunction r b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
            BasicBlock -> T c -> T c -> CodeGenFunction r ()
forall r. BasicBlock -> T c -> T c -> CodeGenFunction r ()
forall a r. C a => BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhi BasicBlock
bb T c
a2 T c
b2 CodeGenFunction r ()
-> CodeGenFunction r () -> CodeGenFunction r ()
forall a b.
CodeGenFunction r a -> CodeGenFunction r b -> CodeGenFunction r b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
            BasicBlock -> T d -> T d -> CodeGenFunction r ()
forall r. BasicBlock -> T d -> T d -> CodeGenFunction r ()
forall a r. C a => BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhi BasicBlock
bb T d
a3 T d
b3


fst :: T (a,b) -> T a
fst :: forall a b. T (a, b) -> T a
fst (Cons (Repr a
a,Repr b
_b)) = Repr a -> T a
forall a. Repr a -> T a
Cons Repr a
a

snd :: T (a,b) -> T b
snd :: forall a b. T (a, b) -> T b
snd (Cons (Repr a
_a,Repr b
b)) = Repr b -> T b
forall a. Repr a -> T a
Cons Repr b
b

curry :: (T (a,b) -> c) -> (T a -> T b -> c)
curry :: forall a b c. (T (a, b) -> c) -> T a -> T b -> c
curry T (a, b) -> c
f T a
a T b
b = T (a, b) -> c
f (T (a, b) -> c) -> T (a, b) -> c
forall a b. (a -> b) -> a -> b
$ T a -> T b -> T (a, b)
forall a b. T a -> T b -> T (a, b)
zip T a
a T b
b

uncurry :: (T a -> T b -> c) -> (T (a,b) -> c)
uncurry :: forall a b c. (T a -> T b -> c) -> T (a, b) -> c
uncurry T a -> T b -> c
f = (T a -> T b -> c) -> (T a, T b) -> c
forall a b c. (a -> b -> c) -> (a, b) -> c
Tup.uncurry T a -> T b -> c
f ((T a, T b) -> c) -> (T (a, b) -> (T a, T b)) -> T (a, b) -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T (a, b) -> (T a, T b)
forall a b. T (a, b) -> (T a, T b)
unzip


mapFst :: (T a0 -> T a1) -> T (a0,b) -> T (a1,b)
mapFst :: forall a0 a1 b. (T a0 -> T a1) -> T (a0, b) -> T (a1, b)
mapFst T a0 -> T a1
f = (T a1 -> T b -> T (a1, b)) -> (T a1, T b) -> T (a1, b)
forall a b c. (a -> b -> c) -> (a, b) -> c
Tup.uncurry T a1 -> T b -> T (a1, b)
forall a b. T a -> T b -> T (a, b)
zip ((T a1, T b) -> T (a1, b))
-> (T (a0, b) -> (T a1, T b)) -> T (a0, b) -> T (a1, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (T a0 -> T a1) -> (T a0, T b) -> (T a1, T b)
forall a c b. (a -> c) -> (a, b) -> (c, b)
TupleHT.mapFst T a0 -> T a1
f ((T a0, T b) -> (T a1, T b))
-> (T (a0, b) -> (T a0, T b)) -> T (a0, b) -> (T a1, T b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T (a0, b) -> (T a0, T b)
forall a b. T (a, b) -> (T a, T b)
unzip

mapSnd :: (T b0 -> T b1) -> T (a,b0) -> T (a,b1)
mapSnd :: forall b0 b1 a. (T b0 -> T b1) -> T (a, b0) -> T (a, b1)
mapSnd T b0 -> T b1
f = (T a -> T b1 -> T (a, b1)) -> (T a, T b1) -> T (a, b1)
forall a b c. (a -> b -> c) -> (a, b) -> c
Tup.uncurry T a -> T b1 -> T (a, b1)
forall a b. T a -> T b -> T (a, b)
zip ((T a, T b1) -> T (a, b1))
-> (T (a, b0) -> (T a, T b1)) -> T (a, b0) -> T (a, b1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (T b0 -> T b1) -> (T a, T b0) -> (T a, T b1)
forall b c a. (b -> c) -> (a, b) -> (a, c)
TupleHT.mapSnd T b0 -> T b1
f ((T a, T b0) -> (T a, T b1))
-> (T (a, b0) -> (T a, T b0)) -> T (a, b0) -> (T a, T b1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T (a, b0) -> (T a, T b0)
forall a b. T (a, b) -> (T a, T b)
unzip

mapFstF :: (Functor f) => (T a0 -> f (T a1)) -> T (a0,b) -> f (T (a1,b))
mapFstF :: forall (f :: * -> *) a0 a1 b.
Functor f =>
(T a0 -> f (T a1)) -> T (a0, b) -> f (T (a1, b))
mapFstF T a0 -> f (T a1)
f = ((T a1, T b) -> T (a1, b)) -> f (T a1, T b) -> f (T (a1, b))
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((T a1 -> T b -> T (a1, b)) -> (T a1, T b) -> T (a1, b)
forall a b c. (a -> b -> c) -> (a, b) -> c
Tup.uncurry T a1 -> T b -> T (a1, b)
forall a b. T a -> T b -> T (a, b)
zip) (f (T a1, T b) -> f (T (a1, b)))
-> (T (a0, b) -> f (T a1, T b)) -> T (a0, b) -> f (T (a1, b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (T a0 -> f (T a1)) -> (T a0, T b) -> f (T a1, T b)
forall (f :: * -> *) a c b.
Functor f =>
(a -> f c) -> (a, b) -> f (c, b)
FuncHT.mapFst T a0 -> f (T a1)
f ((T a0, T b) -> f (T a1, T b))
-> (T (a0, b) -> (T a0, T b)) -> T (a0, b) -> f (T a1, T b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T (a0, b) -> (T a0, T b)
forall a b. T (a, b) -> (T a, T b)
unzip

mapSndF :: (Functor f) => (T b0 -> f (T b1)) -> T (a,b0) -> f (T (a,b1))
mapSndF :: forall (f :: * -> *) b0 b1 a.
Functor f =>
(T b0 -> f (T b1)) -> T (a, b0) -> f (T (a, b1))
mapSndF T b0 -> f (T b1)
f = ((T a, T b1) -> T (a, b1)) -> f (T a, T b1) -> f (T (a, b1))
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((T a -> T b1 -> T (a, b1)) -> (T a, T b1) -> T (a, b1)
forall a b c. (a -> b -> c) -> (a, b) -> c
Tup.uncurry T a -> T b1 -> T (a, b1)
forall a b. T a -> T b -> T (a, b)
zip) (f (T a, T b1) -> f (T (a, b1)))
-> (T (a, b0) -> f (T a, T b1)) -> T (a, b0) -> f (T (a, b1))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (T b0 -> f (T b1)) -> (T a, T b0) -> f (T a, T b1)
forall (f :: * -> *) b c a.
Functor f =>
(b -> f c) -> (a, b) -> f (a, c)
FuncHT.mapSnd T b0 -> f (T b1)
f ((T a, T b0) -> f (T a, T b1))
-> (T (a, b0) -> (T a, T b0)) -> T (a, b0) -> f (T a, T b1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T (a, b0) -> (T a, T b0)
forall a b. T (a, b) -> (T a, T b)
unzip

swap :: T (a,b) -> T (b,a)
swap :: forall a b. T (a, b) -> T (b, a)
swap = (T b -> T a -> T (b, a)) -> (T b, T a) -> T (b, a)
forall a b c. (a -> b -> c) -> (a, b) -> c
Tup.uncurry T b -> T a -> T (b, a)
forall a b. T a -> T b -> T (a, b)
zip ((T b, T a) -> T (b, a))
-> (T (a, b) -> (T b, T a)) -> T (a, b) -> T (b, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (T a, T b) -> (T b, T a)
forall a b. (a, b) -> (b, a)
TupleHT.swap ((T a, T b) -> (T b, T a))
-> (T (a, b) -> (T a, T b)) -> T (a, b) -> (T b, T a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T (a, b) -> (T a, T b)
forall a b. T (a, b) -> (T a, T b)
unzip


fst3 :: T (a,b,c) -> T a
fst3 :: forall a b c. T (a, b, c) -> T a
fst3 (Cons (Repr a
a,Repr b
_b,Repr c
_c)) = Repr a -> T a
forall a. Repr a -> T a
Cons Repr a
a

snd3 :: T (a,b,c) -> T b
snd3 :: forall a b c. T (a, b, c) -> T b
snd3 (Cons (Repr a
_a,Repr b
b,Repr c
_c)) = Repr b -> T b
forall a. Repr a -> T a
Cons Repr b
b

thd3 :: T (a,b,c) -> T c
thd3 :: forall a b c. T (a, b, c) -> T c
thd3 (Cons (Repr a
_a,Repr b
_b,Repr c
c)) = Repr c -> T c
forall a. Repr a -> T a
Cons Repr c
c

curry3 :: (T (a,b,c) -> d) -> (T a -> T b -> T c -> d)
curry3 :: forall a b c d. (T (a, b, c) -> d) -> T a -> T b -> T c -> d
curry3 T (a, b, c) -> d
f T a
a T b
b T c
c = T (a, b, c) -> d
f (T (a, b, c) -> d) -> T (a, b, c) -> d
forall a b. (a -> b) -> a -> b
$ T a -> T b -> T c -> T (a, b, c)
forall a b c. T a -> T b -> T c -> T (a, b, c)
zip3 T a
a T b
b T c
c

uncurry3 :: (T a -> T b -> T c -> d) -> (T (a,b,c) -> d)
uncurry3 :: forall a b c d. (T a -> T b -> T c -> d) -> T (a, b, c) -> d
uncurry3 T a -> T b -> T c -> d
f = (T a -> T b -> T c -> d) -> (T a, T b, T c) -> d
forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
TupleHT.uncurry3 T a -> T b -> T c -> d
f ((T a, T b, T c) -> d)
-> (T (a, b, c) -> (T a, T b, T c)) -> T (a, b, c) -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T (a, b, c) -> (T a, T b, T c)
forall a b c. T (a, b, c) -> (T a, T b, T c)
unzip3


mapFst3 :: (T a0 -> T a1) -> T (a0,b,c) -> T (a1,b,c)
mapFst3 :: forall a0 a1 b c. (T a0 -> T a1) -> T (a0, b, c) -> T (a1, b, c)
mapFst3 T a0 -> T a1
f = (T a1 -> T b -> T c -> T (a1, b, c))
-> (T a1, T b, T c) -> T (a1, b, c)
forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
TupleHT.uncurry3 T a1 -> T b -> T c -> T (a1, b, c)
forall a b c. T a -> T b -> T c -> T (a, b, c)
zip3 ((T a1, T b, T c) -> T (a1, b, c))
-> (T (a0, b, c) -> (T a1, T b, T c))
-> T (a0, b, c)
-> T (a1, b, c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (T a0 -> T a1) -> (T a0, T b, T c) -> (T a1, T b, T c)
forall a d b c. (a -> d) -> (a, b, c) -> (d, b, c)
TupleHT.mapFst3 T a0 -> T a1
f ((T a0, T b, T c) -> (T a1, T b, T c))
-> (T (a0, b, c) -> (T a0, T b, T c))
-> T (a0, b, c)
-> (T a1, T b, T c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T (a0, b, c) -> (T a0, T b, T c)
forall a b c. T (a, b, c) -> (T a, T b, T c)
unzip3

mapSnd3 :: (T b0 -> T b1) -> T (a,b0,c) -> T (a,b1,c)
mapSnd3 :: forall b0 b1 a c. (T b0 -> T b1) -> T (a, b0, c) -> T (a, b1, c)
mapSnd3 T b0 -> T b1
f = (T a -> T b1 -> T c -> T (a, b1, c))
-> (T a, T b1, T c) -> T (a, b1, c)
forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
TupleHT.uncurry3 T a -> T b1 -> T c -> T (a, b1, c)
forall a b c. T a -> T b -> T c -> T (a, b, c)
zip3 ((T a, T b1, T c) -> T (a, b1, c))
-> (T (a, b0, c) -> (T a, T b1, T c))
-> T (a, b0, c)
-> T (a, b1, c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (T b0 -> T b1) -> (T a, T b0, T c) -> (T a, T b1, T c)
forall b d a c. (b -> d) -> (a, b, c) -> (a, d, c)
TupleHT.mapSnd3 T b0 -> T b1
f ((T a, T b0, T c) -> (T a, T b1, T c))
-> (T (a, b0, c) -> (T a, T b0, T c))
-> T (a, b0, c)
-> (T a, T b1, T c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T (a, b0, c) -> (T a, T b0, T c)
forall a b c. T (a, b, c) -> (T a, T b, T c)
unzip3

mapThd3 :: (T c0 -> T c1) -> T (a,b,c0) -> T (a,b,c1)
mapThd3 :: forall c0 c1 a b. (T c0 -> T c1) -> T (a, b, c0) -> T (a, b, c1)
mapThd3 T c0 -> T c1
f = (T a -> T b -> T c1 -> T (a, b, c1))
-> (T a, T b, T c1) -> T (a, b, c1)
forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
TupleHT.uncurry3 T a -> T b -> T c1 -> T (a, b, c1)
forall a b c. T a -> T b -> T c -> T (a, b, c)
zip3 ((T a, T b, T c1) -> T (a, b, c1))
-> (T (a, b, c0) -> (T a, T b, T c1))
-> T (a, b, c0)
-> T (a, b, c1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (T c0 -> T c1) -> (T a, T b, T c0) -> (T a, T b, T c1)
forall c d a b. (c -> d) -> (a, b, c) -> (a, b, d)
TupleHT.mapThd3 T c0 -> T c1
f ((T a, T b, T c0) -> (T a, T b, T c1))
-> (T (a, b, c0) -> (T a, T b, T c0))
-> T (a, b, c0)
-> (T a, T b, T c1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T (a, b, c0) -> (T a, T b, T c0)
forall a b c. T (a, b, c) -> (T a, T b, T c)
unzip3

mapFst3F :: (Functor f) => (T a0 -> f (T a1)) -> T (a0,b,c) -> f (T (a1,b,c))
mapFst3F :: forall (f :: * -> *) a0 a1 b c.
Functor f =>
(T a0 -> f (T a1)) -> T (a0, b, c) -> f (T (a1, b, c))
mapFst3F T a0 -> f (T a1)
f = ((T a1, T b, T c) -> T (a1, b, c))
-> f (T a1, T b, T c) -> f (T (a1, b, c))
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((T a1 -> T b -> T c -> T (a1, b, c))
-> (T a1, T b, T c) -> T (a1, b, c)
forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
TupleHT.uncurry3 T a1 -> T b -> T c -> T (a1, b, c)
forall a b c. T a -> T b -> T c -> T (a, b, c)
zip3) (f (T a1, T b, T c) -> f (T (a1, b, c)))
-> (T (a0, b, c) -> f (T a1, T b, T c))
-> T (a0, b, c)
-> f (T (a1, b, c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (T a0 -> f (T a1)) -> (T a0, T b, T c) -> f (T a1, T b, T c)
forall (f :: * -> *) a d b c.
Functor f =>
(a -> f d) -> (a, b, c) -> f (d, b, c)
FuncHT.mapFst3 T a0 -> f (T a1)
f ((T a0, T b, T c) -> f (T a1, T b, T c))
-> (T (a0, b, c) -> (T a0, T b, T c))
-> T (a0, b, c)
-> f (T a1, T b, T c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T (a0, b, c) -> (T a0, T b, T c)
forall a b c. T (a, b, c) -> (T a, T b, T c)
unzip3

mapSnd3F :: (Functor f) => (T b0 -> f (T b1)) -> T (a,b0,c) -> f (T (a,b1,c))
mapSnd3F :: forall (f :: * -> *) b0 b1 a c.
Functor f =>
(T b0 -> f (T b1)) -> T (a, b0, c) -> f (T (a, b1, c))
mapSnd3F T b0 -> f (T b1)
f = ((T a, T b1, T c) -> T (a, b1, c))
-> f (T a, T b1, T c) -> f (T (a, b1, c))
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((T a -> T b1 -> T c -> T (a, b1, c))
-> (T a, T b1, T c) -> T (a, b1, c)
forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
TupleHT.uncurry3 T a -> T b1 -> T c -> T (a, b1, c)
forall a b c. T a -> T b -> T c -> T (a, b, c)
zip3) (f (T a, T b1, T c) -> f (T (a, b1, c)))
-> (T (a, b0, c) -> f (T a, T b1, T c))
-> T (a, b0, c)
-> f (T (a, b1, c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (T b0 -> f (T b1)) -> (T a, T b0, T c) -> f (T a, T b1, T c)
forall (f :: * -> *) b d a c.
Functor f =>
(b -> f d) -> (a, b, c) -> f (a, d, c)
FuncHT.mapSnd3 T b0 -> f (T b1)
f ((T a, T b0, T c) -> f (T a, T b1, T c))
-> (T (a, b0, c) -> (T a, T b0, T c))
-> T (a, b0, c)
-> f (T a, T b1, T c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T (a, b0, c) -> (T a, T b0, T c)
forall a b c. T (a, b, c) -> (T a, T b, T c)
unzip3

mapThd3F :: (Functor f) => (T c0 -> f (T c1)) -> T (a,b,c0) -> f (T (a,b,c1))
mapThd3F :: forall (f :: * -> *) c0 c1 a b.
Functor f =>
(T c0 -> f (T c1)) -> T (a, b, c0) -> f (T (a, b, c1))
mapThd3F T c0 -> f (T c1)
f = ((T a, T b, T c1) -> T (a, b, c1))
-> f (T a, T b, T c1) -> f (T (a, b, c1))
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((T a -> T b -> T c1 -> T (a, b, c1))
-> (T a, T b, T c1) -> T (a, b, c1)
forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
TupleHT.uncurry3 T a -> T b -> T c1 -> T (a, b, c1)
forall a b c. T a -> T b -> T c -> T (a, b, c)
zip3) (f (T a, T b, T c1) -> f (T (a, b, c1)))
-> (T (a, b, c0) -> f (T a, T b, T c1))
-> T (a, b, c0)
-> f (T (a, b, c1))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (T c0 -> f (T c1)) -> (T a, T b, T c0) -> f (T a, T b, T c1)
forall (f :: * -> *) c d a b.
Functor f =>
(c -> f d) -> (a, b, c) -> f (a, b, d)
FuncHT.mapThd3 T c0 -> f (T c1)
f ((T a, T b, T c0) -> f (T a, T b, T c1))
-> (T (a, b, c0) -> (T a, T b, T c0))
-> T (a, b, c0)
-> f (T a, T b, T c1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T (a, b, c0) -> (T a, T b, T c0)
forall a b c. T (a, b, c) -> (T a, T b, T c)
unzip3


zip :: T a -> T b -> T (a,b)
zip :: forall a b. T a -> T b -> T (a, b)
zip (Cons Repr a
a) (Cons Repr b
b) = Repr (a, b) -> T (a, b)
forall a. Repr a -> T a
Cons (Repr a
a,Repr b
b)

zip3 :: T a -> T b -> T c -> T (a,b,c)
zip3 :: forall a b c. T a -> T b -> T c -> T (a, b, c)
zip3 (Cons Repr a
a) (Cons Repr b
b) (Cons Repr c
c) = Repr (a, b, c) -> T (a, b, c)
forall a. Repr a -> T a
Cons (Repr a
a,Repr b
b,Repr c
c)

zip4 :: T a -> T b -> T c -> T d -> T (a,b,c,d)
zip4 :: forall a b c d. T a -> T b -> T c -> T d -> T (a, b, c, d)
zip4 (Cons Repr a
a) (Cons Repr b
b) (Cons Repr c
c) (Cons Repr d
d) = Repr (a, b, c, d) -> T (a, b, c, d)
forall a. Repr a -> T a
Cons (Repr a
a,Repr b
b,Repr c
c,Repr d
d)

unzip :: T (a,b) -> (T a, T b)
unzip :: forall a b. T (a, b) -> (T a, T b)
unzip (Cons (Repr a
a,Repr b
b)) = (Repr a -> T a
forall a. Repr a -> T a
Cons Repr a
a, Repr b -> T b
forall a. Repr a -> T a
Cons Repr b
b)

unzip3 :: T (a,b,c) -> (T a, T b, T c)
unzip3 :: forall a b c. T (a, b, c) -> (T a, T b, T c)
unzip3 (Cons (Repr a
a,Repr b
b,Repr c
c)) = (Repr a -> T a
forall a. Repr a -> T a
Cons Repr a
a, Repr b -> T b
forall a. Repr a -> T a
Cons Repr b
b, Repr c -> T c
forall a. Repr a -> T a
Cons Repr c
c)

unzip4 :: T (a,b,c,d) -> (T a, T b, T c, T d)
unzip4 :: forall a b c d. T (a, b, c, d) -> (T a, T b, T c, T d)
unzip4 (Cons (Repr a
a,Repr b
b,Repr c
c,Repr d
d)) = (Repr a -> T a
forall a. Repr a -> T a
Cons Repr a
a, Repr b -> T b
forall a. Repr a -> T a
Cons Repr b
b, Repr c -> T c
forall a. Repr a -> T a
Cons Repr c
c, Repr d -> T d
forall a. Repr a -> T a
Cons Repr d
d)


instance (C tuple) => C (StoreTuple.Tuple tuple) where
   type Repr (StoreTuple.Tuple tuple) = Repr tuple
   cons :: Tuple tuple -> T (Tuple tuple)
cons = T tuple -> T (Tuple tuple)
forall tuple. T tuple -> T (Tuple tuple)
tuple (T tuple -> T (Tuple tuple))
-> (Tuple tuple -> T tuple) -> Tuple tuple -> T (Tuple tuple)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. tuple -> T tuple
forall a. C a => a -> T a
cons (tuple -> T tuple)
-> (Tuple tuple -> tuple) -> Tuple tuple -> T tuple
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tuple tuple -> tuple
forall a. Tuple a -> a
StoreTuple.getTuple
   undef :: T (Tuple tuple)
undef = T tuple -> T (Tuple tuple)
forall tuple. T tuple -> T (Tuple tuple)
tuple T tuple
forall a. C a => T a
undef
   zero :: T (Tuple tuple)
zero = T tuple -> T (Tuple tuple)
forall tuple. T tuple -> T (Tuple tuple)
tuple T tuple
forall a. C a => T a
zero
   phi :: forall r.
BasicBlock
-> T (Tuple tuple) -> CodeGenFunction r (T (Tuple tuple))
phi BasicBlock
bb = (T tuple -> T (Tuple tuple))
-> CodeGenFunction r (T tuple)
-> CodeGenFunction r (T (Tuple tuple))
forall a b. (a -> b) -> CodeGenFunction r a -> CodeGenFunction r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap T tuple -> T (Tuple tuple)
forall tuple. T tuple -> T (Tuple tuple)
tuple (CodeGenFunction r (T tuple)
 -> CodeGenFunction r (T (Tuple tuple)))
-> (T (Tuple tuple) -> CodeGenFunction r (T tuple))
-> T (Tuple tuple)
-> CodeGenFunction r (T (Tuple tuple))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BasicBlock -> T tuple -> CodeGenFunction r (T tuple)
forall r. BasicBlock -> T tuple -> CodeGenFunction r (T tuple)
forall a r. C a => BasicBlock -> T a -> CodeGenFunction r (T a)
phi BasicBlock
bb (T tuple -> CodeGenFunction r (T tuple))
-> (T (Tuple tuple) -> T tuple)
-> T (Tuple tuple)
-> CodeGenFunction r (T tuple)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T (Tuple tuple) -> T tuple
forall tuple. T (Tuple tuple) -> T tuple
untuple
   addPhi :: forall r.
BasicBlock
-> T (Tuple tuple) -> T (Tuple tuple) -> CodeGenFunction r ()
addPhi BasicBlock
bb T (Tuple tuple)
a T (Tuple tuple)
b = BasicBlock -> T tuple -> T tuple -> CodeGenFunction r ()
forall r. BasicBlock -> T tuple -> T tuple -> CodeGenFunction r ()
forall a r. C a => BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhi BasicBlock
bb (T (Tuple tuple) -> T tuple
forall tuple. T (Tuple tuple) -> T tuple
untuple T (Tuple tuple)
a) (T (Tuple tuple) -> T tuple
forall tuple. T (Tuple tuple) -> T tuple
untuple T (Tuple tuple)
b)

tuple :: T tuple -> T (StoreTuple.Tuple tuple)
tuple :: forall tuple. T tuple -> T (Tuple tuple)
tuple (Cons Repr tuple
a) = Repr (Tuple tuple) -> T (Tuple tuple)
forall a. Repr a -> T a
Cons Repr tuple
Repr (Tuple tuple)
a

untuple :: T (StoreTuple.Tuple tuple) -> T tuple
untuple :: forall tuple. T (Tuple tuple) -> T tuple
untuple (Cons Repr (Tuple tuple)
a) = Repr tuple -> T tuple
forall a. Repr a -> T a
Cons Repr tuple
Repr (Tuple tuple)
a


class Struct struct where
   consStruct :: (Struct.T struct ~ a) => a -> T a
   undefStruct :: (Struct.T struct ~ a) => T a
   zeroStruct :: (Struct.T struct ~ a) => T a
   phiStruct :: (Struct.T struct ~ a) =>
      LLVM.BasicBlock -> T a -> LLVM.CodeGenFunction r (T a)
   addPhiStruct :: (Struct.T struct ~ a) =>
      LLVM.BasicBlock -> T a -> T a -> LLVM.CodeGenFunction r ()

instance (Struct struct) => C (Struct.T struct) where
   type Repr (Struct.T struct) = Struct.T (Repr struct)
   cons :: T struct -> T (T struct)
cons = T struct -> T (T struct)
forall a. (T struct ~ a) => a -> T a
forall struct a. (Struct struct, T struct ~ a) => a -> T a
consStruct
   undef :: T (T struct)
undef = T (T struct)
forall a. (T struct ~ a) => T a
forall struct a. (Struct struct, T struct ~ a) => T a
undefStruct
   zero :: T (T struct)
zero = T (T struct)
forall a. (T struct ~ a) => T a
forall struct a. (Struct struct, T struct ~ a) => T a
zeroStruct
   phi :: forall r.
BasicBlock -> T (T struct) -> CodeGenFunction r (T (T struct))
phi = BasicBlock -> T (T struct) -> CodeGenFunction r (T (T struct))
forall struct a r.
(Struct struct, T struct ~ a) =>
BasicBlock -> T a -> CodeGenFunction r (T a)
forall a r.
(T struct ~ a) =>
BasicBlock -> T a -> CodeGenFunction r (T a)
phiStruct
   addPhi :: forall r.
BasicBlock -> T (T struct) -> T (T struct) -> CodeGenFunction r ()
addPhi = BasicBlock -> T (T struct) -> T (T struct) -> CodeGenFunction r ()
forall struct a r.
(Struct struct, T struct ~ a) =>
BasicBlock -> T a -> T a -> CodeGenFunction r ()
forall a r.
(T struct ~ a) =>
BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhiStruct

instance Struct () where
   consStruct :: forall a. (T () ~ a) => a -> T a
consStruct a
unit = Repr a -> T a
forall a. Repr a -> T a
Cons a
Repr a
unit
   undefStruct :: forall a. (T () ~ a) => T a
undefStruct = Repr a -> T a
forall a. Repr a -> T a
Cons (() -> T ()
forall struct. struct -> T struct
Struct.Cons ())
   zeroStruct :: forall a. (T () ~ a) => T a
zeroStruct = Repr a -> T a
forall a. Repr a -> T a
Cons (() -> T ()
forall struct. struct -> T struct
Struct.Cons ())
   phiStruct :: forall a r.
(T () ~ a) =>
BasicBlock -> T a -> CodeGenFunction r (T a)
phiStruct BasicBlock
_bb = T a -> CodeGenFunction r (T a)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return
   addPhiStruct :: forall a r.
(T () ~ a) =>
BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhiStruct BasicBlock
_bb T a
_a T a
_b = () -> CodeGenFunction r ()
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

structCons :: T a -> T (Struct.T as) -> T (Struct.T (a,as))
structCons :: forall a as. T a -> T (T as) -> T (T (a, as))
structCons (Cons Repr a
b) (Cons (Struct.Cons Repr as
bs)) = Repr (T (a, as)) -> T (T (a, as))
forall a. Repr a -> T a
Cons ((Repr a, Repr as) -> T (Repr a, Repr as)
forall struct. struct -> T struct
Struct.Cons (Repr a
b,Repr as
bs))

structUncons :: T (Struct.T (a,as)) -> (T a, T (Struct.T as))
structUncons :: forall a as. T (T (a, as)) -> (T a, T (T as))
structUncons (Cons (Struct.Cons (Repr a
b,Repr as
bs))) = (Repr a -> T a
forall a. Repr a -> T a
Cons Repr a
b, Repr (T as) -> T (T as)
forall a. Repr a -> T a
Cons (Repr as -> T (Repr as)
forall struct. struct -> T struct
Struct.Cons Repr as
bs))

instance (C a, Struct as) => Struct (a,as) where
   consStruct :: forall a. (T (a, as) ~ a) => a -> T a
consStruct (Struct.Cons (a
a,as
as)) =
      T a -> T (T as) -> T (T (a, as))
forall a as. T a -> T (T as) -> T (T (a, as))
structCons (a -> T a
forall a. C a => a -> T a
cons a
a) (T as -> T (T as)
forall a. (T as ~ a) => a -> T a
forall struct a. (Struct struct, T struct ~ a) => a -> T a
consStruct (as -> T as
forall struct. struct -> T struct
Struct.Cons as
as))
   undefStruct :: forall a. (T (a, as) ~ a) => T a
undefStruct = T a -> T (T as) -> T (T (a, as))
forall a as. T a -> T (T as) -> T (T (a, as))
structCons T a
forall a. C a => T a
undef T (T as)
forall a. (T as ~ a) => T a
forall struct a. (Struct struct, T struct ~ a) => T a
undefStruct
   zeroStruct :: forall a. (T (a, as) ~ a) => T a
zeroStruct = T a -> T (T as) -> T (T (a, as))
forall a as. T a -> T (T as) -> T (T (a, as))
structCons T a
forall a. C a => T a
zero T (T as)
forall a. (T as ~ a) => T a
forall struct a. (Struct struct, T struct ~ a) => T a
zeroStruct
   phiStruct :: forall a r.
(T (a, as) ~ a) =>
BasicBlock -> T a -> CodeGenFunction r (T a)
phiStruct BasicBlock
bb T a
at =
      case T (T (a, as)) -> (T a, T (T as))
forall a as. T (T (a, as)) -> (T a, T (T as))
structUncons T a
T (T (a, as))
at of
         (T a
a,T (T as)
as) -> (T a -> T (T as) -> T a)
-> CodeGenFunction r (T a)
-> CodeGenFunction r (T (T as))
-> CodeGenFunction r (T a)
forall (m :: * -> *) a b r.
Monad m =>
(a -> b -> r) -> m a -> m b -> m r
Monad.lift2 T a -> T (T as) -> T a
T a -> T (T as) -> T (T (a, as))
forall a as. T a -> T (T as) -> T (T (a, as))
structCons (BasicBlock -> T a -> CodeGenFunction r (T a)
forall r. BasicBlock -> T a -> CodeGenFunction r (T a)
forall a r. C a => BasicBlock -> T a -> CodeGenFunction r (T a)
phi BasicBlock
bb T a
a) (BasicBlock -> T (T as) -> CodeGenFunction r (T (T as))
forall struct a r.
(Struct struct, T struct ~ a) =>
BasicBlock -> T a -> CodeGenFunction r (T a)
forall a r.
(T as ~ a) =>
BasicBlock -> T a -> CodeGenFunction r (T a)
phiStruct BasicBlock
bb T (T as)
as)
   addPhiStruct :: forall a r.
(T (a, as) ~ a) =>
BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhiStruct BasicBlock
bb T a
at T a
bt =
      case (T (T (a, as)) -> (T a, T (T as))
forall a as. T (T (a, as)) -> (T a, T (T as))
structUncons T a
T (T (a, as))
at, T (T (a, as)) -> (T a, T (T as))
forall a as. T (T (a, as)) -> (T a, T (T as))
structUncons T a
T (T (a, as))
bt) of
         ((T a
a,T (T as)
as), (T a
b,T (T as)
bs)) -> BasicBlock -> T a -> T a -> CodeGenFunction r ()
forall r. BasicBlock -> T a -> T a -> CodeGenFunction r ()
forall a r. C a => BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhi BasicBlock
bb T a
a T a
b CodeGenFunction r ()
-> CodeGenFunction r () -> CodeGenFunction r ()
forall a b.
CodeGenFunction r a -> CodeGenFunction r b -> CodeGenFunction r b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BasicBlock -> T (T as) -> T (T as) -> CodeGenFunction r ()
forall struct a r.
(Struct struct, T struct ~ a) =>
BasicBlock -> T a -> T a -> CodeGenFunction r ()
forall a r.
(T as ~ a) =>
BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhiStruct BasicBlock
bb T (T as)
as T (T as)
bs


instance (LLVM.IsConst a, LLVM.IsFirstClass a) => C (EE.Stored a) where
   type Repr (EE.Stored a) = LLVM.Value a
   cons :: Stored a -> T (Stored a)
cons = Value a -> T (Stored a)
Repr (Stored a) -> T (Stored a)
forall a. Repr a -> T a
Cons (Value a -> T (Stored a))
-> (Stored a -> Value a) -> Stored a -> T (Stored a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value a
forall a. IsConst a => a -> Value a
LLVM.valueOf (a -> Value a) -> (Stored a -> a) -> Stored a -> Value a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stored a -> a
forall a. Stored a -> a
EE.getStored
   undef :: T (Stored a)
undef = T (Stored a)
forall al a. (IsType al, Value al ~ Repr a) => T a
undefPrimitive
   zero :: T (Stored a)
zero = T (Stored a)
forall al a. (IsType al, Value al ~ Repr a) => T a
zeroPrimitive
   phi :: forall r.
BasicBlock -> T (Stored a) -> CodeGenFunction r (T (Stored a))
phi = BasicBlock -> T (Stored a) -> CodeGenFunction r (T (Stored a))
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> CodeGenFunction r (T a)
phiPrimitive
   addPhi :: forall r.
BasicBlock -> T (Stored a) -> T (Stored a) -> CodeGenFunction r ()
addPhi = BasicBlock -> T (Stored a) -> T (Stored a) -> CodeGenFunction r ()
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhiPrimitive


instance C a => C (Tagged tag a) where
   type Repr (Tagged tag a) = Repr a
   cons :: Tagged tag a -> T (Tagged tag a)
cons = T a -> T (Tagged tag a)
forall a tag. T a -> T (Tagged tag a)
tag (T a -> T (Tagged tag a))
-> (Tagged tag a -> T a) -> Tagged tag a -> T (Tagged tag a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> T a
forall a. C a => a -> T a
cons (a -> T a) -> (Tagged tag a -> a) -> Tagged tag a -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tagged tag a -> a
forall {k} (s :: k) b. Tagged s b -> b
unTagged
   undef :: T (Tagged tag a)
undef = T a -> T (Tagged tag a)
forall a tag. T a -> T (Tagged tag a)
tag T a
forall a. C a => T a
undef
   zero :: T (Tagged tag a)
zero = T a -> T (Tagged tag a)
forall a tag. T a -> T (Tagged tag a)
tag T a
forall a. C a => T a
zero
   phi :: forall r.
BasicBlock
-> T (Tagged tag a) -> CodeGenFunction r (T (Tagged tag a))
phi BasicBlock
bb = (T a -> T (Tagged tag a))
-> CodeGenFunction r (T a) -> CodeGenFunction r (T (Tagged tag a))
forall a b. (a -> b) -> CodeGenFunction r a -> CodeGenFunction r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap T a -> T (Tagged tag a)
forall a tag. T a -> T (Tagged tag a)
tag (CodeGenFunction r (T a) -> CodeGenFunction r (T (Tagged tag a)))
-> (T (Tagged tag a) -> CodeGenFunction r (T a))
-> T (Tagged tag a)
-> CodeGenFunction r (T (Tagged tag a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BasicBlock -> T a -> CodeGenFunction r (T a)
forall r. BasicBlock -> T a -> CodeGenFunction r (T a)
forall a r. C a => BasicBlock -> T a -> CodeGenFunction r (T a)
phi BasicBlock
bb (T a -> CodeGenFunction r (T a))
-> (T (Tagged tag a) -> T a)
-> T (Tagged tag a)
-> CodeGenFunction r (T a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T (Tagged tag a) -> T a
forall tag a. T (Tagged tag a) -> T a
untag
   addPhi :: forall r.
BasicBlock
-> T (Tagged tag a) -> T (Tagged tag a) -> CodeGenFunction r ()
addPhi BasicBlock
bb T (Tagged tag a)
a T (Tagged tag a)
b = BasicBlock -> T a -> T a -> CodeGenFunction r ()
forall r. BasicBlock -> T a -> T a -> CodeGenFunction r ()
forall a r. C a => BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhi BasicBlock
bb (T (Tagged tag a) -> T a
forall tag a. T (Tagged tag a) -> T a
untag T (Tagged tag a)
a) (T (Tagged tag a) -> T a
forall tag a. T (Tagged tag a) -> T a
untag T (Tagged tag a)
b)

tag :: T a -> T (Tagged tag a)
tag :: forall a tag. T a -> T (Tagged tag a)
tag = T a -> T (Tagged tag a)
forall a b. (Repr a ~ Repr b) => T a -> T b
cast

untag :: T (Tagged tag a) -> T a
untag :: forall tag a. T (Tagged tag a) -> T a
untag = T (Tagged tag a) -> T a
forall a b. (Repr a ~ Repr b) => T a -> T b
cast

liftTaggedM ::
   (Monad m) => (T a -> m (T b)) -> T (Tagged tag a) -> m (T (Tagged tag b))
liftTaggedM :: forall (m :: * -> *) a b tag.
Monad m =>
(T a -> m (T b)) -> T (Tagged tag a) -> m (T (Tagged tag b))
liftTaggedM T a -> m (T b)
f = (T b -> T (Tagged tag b)) -> m (T b) -> m (T (Tagged tag b))
forall (m :: * -> *) a r. Monad m => (a -> r) -> m a -> m r
Monad.lift T b -> T (Tagged tag b)
forall a tag. T a -> T (Tagged tag a)
tag (m (T b) -> m (T (Tagged tag b)))
-> (T (Tagged tag a) -> m (T b))
-> T (Tagged tag a)
-> m (T (Tagged tag b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> m (T b)
f (T a -> m (T b))
-> (T (Tagged tag a) -> T a) -> T (Tagged tag a) -> m (T b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T (Tagged tag a) -> T a
forall tag a. T (Tagged tag a) -> T a
untag

liftTaggedM2 ::
   (Monad m) =>
   (T a -> T b -> m (T c)) ->
   T (Tagged tag a) -> T (Tagged tag b) -> m (T (Tagged tag c))
liftTaggedM2 :: forall (m :: * -> *) a b c tag.
Monad m =>
(T a -> T b -> m (T c))
-> T (Tagged tag a) -> T (Tagged tag b) -> m (T (Tagged tag c))
liftTaggedM2 T a -> T b -> m (T c)
f T (Tagged tag a)
a T (Tagged tag b)
b = (T c -> T (Tagged tag c)) -> m (T c) -> m (T (Tagged tag c))
forall (m :: * -> *) a r. Monad m => (a -> r) -> m a -> m r
Monad.lift T c -> T (Tagged tag c)
forall a tag. T a -> T (Tagged tag a)
tag (m (T c) -> m (T (Tagged tag c)))
-> m (T c) -> m (T (Tagged tag c))
forall a b. (a -> b) -> a -> b
$ T a -> T b -> m (T c)
f (T (Tagged tag a) -> T a
forall tag a. T (Tagged tag a) -> T a
untag T (Tagged tag a)
a) (T (Tagged tag b) -> T b
forall tag a. T (Tagged tag a) -> T a
untag T (Tagged tag b)
b)


instance (C a) => C (Complex a) where
   type Repr (Complex a) = Complex (Repr a)
   cons :: Complex a -> T (Complex a)
cons (a
a:+a
b) = T a -> T a -> T (Complex a)
forall a. T a -> T a -> T (Complex a)
consComplex (a -> T a
forall a. C a => a -> T a
cons a
a) (a -> T a
forall a. C a => a -> T a
cons a
b)
   undef :: T (Complex a)
undef = T a -> T a -> T (Complex a)
forall a. T a -> T a -> T (Complex a)
consComplex T a
forall a. C a => T a
undef T a
forall a. C a => T a
undef
   zero :: T (Complex a)
zero = T a -> T a -> T (Complex a)
forall a. T a -> T a -> T (Complex a)
consComplex T a
forall a. C a => T a
zero T a
forall a. C a => T a
zero
   phi :: forall r.
BasicBlock -> T (Complex a) -> CodeGenFunction r (T (Complex a))
phi BasicBlock
bb T (Complex a)
a =
      case T (Complex a) -> (T a, T a)
forall a. T (Complex a) -> (T a, T a)
deconsComplex T (Complex a)
a of
         (T a
a0,T a
a1) ->
            (T a -> T a -> T (Complex a))
-> CodeGenFunction r (T a)
-> CodeGenFunction r (T a)
-> CodeGenFunction r (T (Complex a))
forall (m :: * -> *) a b r.
Monad m =>
(a -> b -> r) -> m a -> m b -> m r
Monad.lift2 T a -> T a -> T (Complex a)
forall a. T a -> T a -> T (Complex a)
consComplex (BasicBlock -> T a -> CodeGenFunction r (T a)
forall r. BasicBlock -> T a -> CodeGenFunction r (T a)
forall a r. C a => BasicBlock -> T a -> CodeGenFunction r (T a)
phi BasicBlock
bb T a
a0) (BasicBlock -> T a -> CodeGenFunction r (T a)
forall r. BasicBlock -> T a -> CodeGenFunction r (T a)
forall a r. C a => BasicBlock -> T a -> CodeGenFunction r (T a)
phi BasicBlock
bb T a
a1)
   addPhi :: forall r.
BasicBlock
-> T (Complex a) -> T (Complex a) -> CodeGenFunction r ()
addPhi BasicBlock
bb T (Complex a)
a T (Complex a)
b =
      case (T (Complex a) -> (T a, T a)
forall a. T (Complex a) -> (T a, T a)
deconsComplex T (Complex a)
a, T (Complex a) -> (T a, T a)
forall a. T (Complex a) -> (T a, T a)
deconsComplex T (Complex a)
b) of
         ((T a
a0,T a
a1), (T a
b0,T a
b1)) ->
            BasicBlock -> T a -> T a -> CodeGenFunction r ()
forall r. BasicBlock -> T a -> T a -> CodeGenFunction r ()
forall a r. C a => BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhi BasicBlock
bb T a
a0 T a
b0 CodeGenFunction r ()
-> CodeGenFunction r () -> CodeGenFunction r ()
forall a b.
CodeGenFunction r a -> CodeGenFunction r b -> CodeGenFunction r b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
            BasicBlock -> T a -> T a -> CodeGenFunction r ()
forall r. BasicBlock -> T a -> T a -> CodeGenFunction r ()
forall a r. C a => BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhi BasicBlock
bb T a
a1 T a
b1

consComplex :: T a -> T a -> T (Complex a)
consComplex :: forall a. T a -> T a -> T (Complex a)
consComplex (Cons Repr a
a) (Cons Repr a
b) = Repr (Complex a) -> T (Complex a)
forall a. Repr a -> T a
Cons (Repr a
aRepr a -> Repr a -> Complex (Repr a)
forall a. a -> a -> Complex a
:+Repr a
b)

deconsComplex :: T (Complex a) -> (T a, T a)
deconsComplex :: forall a. T (Complex a) -> (T a, T a)
deconsComplex (Cons (Repr a
a:+Repr a
b)) = (Repr a -> T a
forall a. Repr a -> T a
Cons Repr a
a, Repr a -> T a
forall a. Repr a -> T a
Cons Repr a
b)



class Compose multituple where
   type Composed multituple
   {- |
   A nested 'zip'.
   -}
   compose :: multituple -> T (Composed multituple)

class
   (Composed (Decomposed T pattern) ~ PatternTuple pattern) =>
      Decompose pattern where
   {- |
   A nested 'unzip'.
   Since it is not obvious how deep to decompose nested tuples,
   you must provide a pattern of the decomposed tuple.
   E.g.

   > f :: MultiValue ((a,b),(c,d)) ->
   >      ((MultiValue a, MultiValue b), MultiValue (c,d))
   > f = decompose ((atom,atom),atom)
   -}
   decompose :: pattern -> T (PatternTuple pattern) -> Decomposed T pattern

type family Decomposed (f :: * -> *) pattern
type family PatternTuple pattern


{- |
A combination of 'compose' and 'decompose'
that let you operate on tuple multivalues as Haskell tuples.
-}
modify ::
   (Compose a, Decompose pattern) =>
   pattern ->
   (Decomposed T pattern -> a) ->
   T (PatternTuple pattern) -> T (Composed a)
modify :: forall a pattern.
(Compose a, Decompose pattern) =>
pattern
-> (Decomposed T pattern -> a)
-> T (PatternTuple pattern)
-> T (Composed a)
modify pattern
p Decomposed T pattern -> a
f = a -> T (Composed a)
forall multituple.
Compose multituple =>
multituple -> T (Composed multituple)
compose (a -> T (Composed a))
-> (T (PatternTuple pattern) -> a)
-> T (PatternTuple pattern)
-> T (Composed a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decomposed T pattern -> a
f (Decomposed T pattern -> a)
-> (T (PatternTuple pattern) -> Decomposed T pattern)
-> T (PatternTuple pattern)
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. pattern -> T (PatternTuple pattern) -> Decomposed T pattern
forall pattern.
Decompose pattern =>
pattern -> T (PatternTuple pattern) -> Decomposed T pattern
decompose pattern
p

modify2 ::
   (Compose a, Decompose patternA, Decompose patternB) =>
   patternA ->
   patternB ->
   (Decomposed T patternA -> Decomposed T patternB -> a) ->
   T (PatternTuple patternA) -> T (PatternTuple patternB) -> T (Composed a)
modify2 :: forall a patternA patternB.
(Compose a, Decompose patternA, Decompose patternB) =>
patternA
-> patternB
-> (Decomposed T patternA -> Decomposed T patternB -> a)
-> T (PatternTuple patternA)
-> T (PatternTuple patternB)
-> T (Composed a)
modify2 patternA
pa patternB
pb Decomposed T patternA -> Decomposed T patternB -> a
f T (PatternTuple patternA)
a T (PatternTuple patternB)
b = a -> T (Composed a)
forall multituple.
Compose multituple =>
multituple -> T (Composed multituple)
compose (a -> T (Composed a)) -> a -> T (Composed a)
forall a b. (a -> b) -> a -> b
$ Decomposed T patternA -> Decomposed T patternB -> a
f (patternA -> T (PatternTuple patternA) -> Decomposed T patternA
forall pattern.
Decompose pattern =>
pattern -> T (PatternTuple pattern) -> Decomposed T pattern
decompose patternA
pa T (PatternTuple patternA)
a) (patternB -> T (PatternTuple patternB) -> Decomposed T patternB
forall pattern.
Decompose pattern =>
pattern -> T (PatternTuple pattern) -> Decomposed T pattern
decompose patternB
pb T (PatternTuple patternB)
b)

modifyF ::
   (Compose a, Decompose pattern, Functor f) =>
   pattern ->
   (Decomposed T pattern -> f a) ->
   T (PatternTuple pattern) -> f (T (Composed a))
modifyF :: forall a pattern (f :: * -> *).
(Compose a, Decompose pattern, Functor f) =>
pattern
-> (Decomposed T pattern -> f a)
-> T (PatternTuple pattern)
-> f (T (Composed a))
modifyF pattern
p Decomposed T pattern -> f a
f = (a -> T (Composed a)) -> f a -> f (T (Composed a))
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> T (Composed a)
forall multituple.
Compose multituple =>
multituple -> T (Composed multituple)
compose (f a -> f (T (Composed a)))
-> (T (PatternTuple pattern) -> f a)
-> T (PatternTuple pattern)
-> f (T (Composed a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decomposed T pattern -> f a
f (Decomposed T pattern -> f a)
-> (T (PatternTuple pattern) -> Decomposed T pattern)
-> T (PatternTuple pattern)
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. pattern -> T (PatternTuple pattern) -> Decomposed T pattern
forall pattern.
Decompose pattern =>
pattern -> T (PatternTuple pattern) -> Decomposed T pattern
decompose pattern
p

modifyF2 ::
   (Compose a, Decompose patternA, Decompose patternB,
    Functor f) =>
   patternA ->
   patternB ->
   (Decomposed T patternA -> Decomposed T patternB -> f a) ->
   T (PatternTuple patternA) -> T (PatternTuple patternB) -> f (T (Composed a))
modifyF2 :: forall a patternA patternB (f :: * -> *).
(Compose a, Decompose patternA, Decompose patternB, Functor f) =>
patternA
-> patternB
-> (Decomposed T patternA -> Decomposed T patternB -> f a)
-> T (PatternTuple patternA)
-> T (PatternTuple patternB)
-> f (T (Composed a))
modifyF2 patternA
pa patternB
pb Decomposed T patternA -> Decomposed T patternB -> f a
f T (PatternTuple patternA)
a T (PatternTuple patternB)
b = (a -> T (Composed a)) -> f a -> f (T (Composed a))
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> T (Composed a)
forall multituple.
Compose multituple =>
multituple -> T (Composed multituple)
compose (f a -> f (T (Composed a))) -> f a -> f (T (Composed a))
forall a b. (a -> b) -> a -> b
$ Decomposed T patternA -> Decomposed T patternB -> f a
f (patternA -> T (PatternTuple patternA) -> Decomposed T patternA
forall pattern.
Decompose pattern =>
pattern -> T (PatternTuple pattern) -> Decomposed T pattern
decompose patternA
pa T (PatternTuple patternA)
a) (patternB -> T (PatternTuple patternB) -> Decomposed T patternB
forall pattern.
Decompose pattern =>
pattern -> T (PatternTuple pattern) -> Decomposed T pattern
decompose patternB
pb T (PatternTuple patternB)
b)



instance Compose (T a) where
   type Composed (T a) = a
   compose :: T a -> T (Composed (T a))
compose = T a -> T a
T a -> T (Composed (T a))
forall a. a -> a
id

instance Decompose (Atom a) where
   decompose :: Atom a -> T (PatternTuple (Atom a)) -> Decomposed T (Atom a)
decompose Atom a
_ = T a -> T a
T (PatternTuple (Atom a)) -> Decomposed T (Atom a)
forall a. a -> a
id

type instance Decomposed f (Atom a) = f a
type instance PatternTuple (Atom a) = a

data Atom a = Atom

atom :: Atom a
atom :: forall a. Atom a
atom = Atom a
forall a. Atom a
Atom


instance Compose () where
   type Composed () = ()
   compose :: () -> T (Composed ())
compose = () -> T ()
() -> T (Composed ())
forall a. C a => a -> T a
cons

instance Decompose () where
   decompose :: () -> T (PatternTuple ()) -> Decomposed T ()
decompose () T (PatternTuple ())
_ = ()

type instance Decomposed f () = ()
type instance PatternTuple () = ()


instance (Compose a, Compose b) => Compose (a,b) where
   type Composed (a,b) = (Composed a, Composed b)
   compose :: (a, b) -> T (Composed (a, b))
compose = (T (Composed a) -> T (Composed b) -> T (Composed a, Composed b))
-> (T (Composed a), T (Composed b)) -> T (Composed a, Composed b)
forall a b c. (a -> b -> c) -> (a, b) -> c
Tup.uncurry T (Composed a) -> T (Composed b) -> T (Composed a, Composed b)
forall a b. T a -> T b -> T (a, b)
zip ((T (Composed a), T (Composed b)) -> T (Composed a, Composed b))
-> ((a, b) -> (T (Composed a), T (Composed b)))
-> (a, b)
-> T (Composed a, Composed b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> T (Composed a), b -> T (Composed b))
-> (a, b) -> (T (Composed a), T (Composed b))
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
TupleHT.mapPair (a -> T (Composed a)
forall multituple.
Compose multituple =>
multituple -> T (Composed multituple)
compose, b -> T (Composed b)
forall multituple.
Compose multituple =>
multituple -> T (Composed multituple)
compose)

instance (Decompose pa, Decompose pb) => Decompose (pa,pb) where
   decompose :: (pa, pb) -> T (PatternTuple (pa, pb)) -> Decomposed T (pa, pb)
decompose (pa
pa,pb
pb) =
      (T (PatternTuple pa) -> Decomposed T pa,
 T (PatternTuple pb) -> Decomposed T pb)
-> (T (PatternTuple pa), T (PatternTuple pb))
-> (Decomposed T pa, Decomposed T pb)
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
TupleHT.mapPair (pa -> T (PatternTuple pa) -> Decomposed T pa
forall pattern.
Decompose pattern =>
pattern -> T (PatternTuple pattern) -> Decomposed T pattern
decompose pa
pa, pb -> T (PatternTuple pb) -> Decomposed T pb
forall pattern.
Decompose pattern =>
pattern -> T (PatternTuple pattern) -> Decomposed T pattern
decompose pb
pb) ((T (PatternTuple pa), T (PatternTuple pb))
 -> (Decomposed T pa, Decomposed T pb))
-> (T (PatternTuple pa, PatternTuple pb)
    -> (T (PatternTuple pa), T (PatternTuple pb)))
-> T (PatternTuple pa, PatternTuple pb)
-> (Decomposed T pa, Decomposed T pb)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T (PatternTuple pa, PatternTuple pb)
-> (T (PatternTuple pa), T (PatternTuple pb))
forall a b. T (a, b) -> (T a, T b)
unzip

type instance Decomposed f (pa,pb) = (Decomposed f pa, Decomposed f pb)
type instance PatternTuple (pa,pb) = (PatternTuple pa, PatternTuple pb)


instance (Compose a, Compose b, Compose c) => Compose (a,b,c) where
   type Composed (a,b,c) = (Composed a, Composed b, Composed c)
   compose :: (a, b, c) -> T (Composed (a, b, c))
compose = (T (Composed a)
 -> T (Composed b)
 -> T (Composed c)
 -> T (Composed a, Composed b, Composed c))
-> (T (Composed a), T (Composed b), T (Composed c))
-> T (Composed a, Composed b, Composed c)
forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
TupleHT.uncurry3 T (Composed a)
-> T (Composed b)
-> T (Composed c)
-> T (Composed a, Composed b, Composed c)
forall a b c. T a -> T b -> T c -> T (a, b, c)
zip3 ((T (Composed a), T (Composed b), T (Composed c))
 -> T (Composed a, Composed b, Composed c))
-> ((a, b, c) -> (T (Composed a), T (Composed b), T (Composed c)))
-> (a, b, c)
-> T (Composed a, Composed b, Composed c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> T (Composed a), b -> T (Composed b), c -> T (Composed c))
-> (a, b, c) -> (T (Composed a), T (Composed b), T (Composed c))
forall a d b e c f.
(a -> d, b -> e, c -> f) -> (a, b, c) -> (d, e, f)
TupleHT.mapTriple (a -> T (Composed a)
forall multituple.
Compose multituple =>
multituple -> T (Composed multituple)
compose, b -> T (Composed b)
forall multituple.
Compose multituple =>
multituple -> T (Composed multituple)
compose, c -> T (Composed c)
forall multituple.
Compose multituple =>
multituple -> T (Composed multituple)
compose)

instance
   (Decompose pa, Decompose pb, Decompose pc) =>
      Decompose (pa,pb,pc) where
   decompose :: (pa, pb, pc)
-> T (PatternTuple (pa, pb, pc)) -> Decomposed T (pa, pb, pc)
decompose (pa
pa,pb
pb,pc
pc) =
      (T (PatternTuple pa) -> Decomposed T pa,
 T (PatternTuple pb) -> Decomposed T pb,
 T (PatternTuple pc) -> Decomposed T pc)
-> (T (PatternTuple pa), T (PatternTuple pb), T (PatternTuple pc))
-> (Decomposed T pa, Decomposed T pb, Decomposed T pc)
forall a d b e c f.
(a -> d, b -> e, c -> f) -> (a, b, c) -> (d, e, f)
TupleHT.mapTriple (pa -> T (PatternTuple pa) -> Decomposed T pa
forall pattern.
Decompose pattern =>
pattern -> T (PatternTuple pattern) -> Decomposed T pattern
decompose pa
pa, pb -> T (PatternTuple pb) -> Decomposed T pb
forall pattern.
Decompose pattern =>
pattern -> T (PatternTuple pattern) -> Decomposed T pattern
decompose pb
pb, pc -> T (PatternTuple pc) -> Decomposed T pc
forall pattern.
Decompose pattern =>
pattern -> T (PatternTuple pattern) -> Decomposed T pattern
decompose pc
pc) ((T (PatternTuple pa), T (PatternTuple pb), T (PatternTuple pc))
 -> (Decomposed T pa, Decomposed T pb, Decomposed T pc))
-> (T (PatternTuple pa, PatternTuple pb, PatternTuple pc)
    -> (T (PatternTuple pa), T (PatternTuple pb), T (PatternTuple pc)))
-> T (PatternTuple pa, PatternTuple pb, PatternTuple pc)
-> (Decomposed T pa, Decomposed T pb, Decomposed T pc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T (PatternTuple pa, PatternTuple pb, PatternTuple pc)
-> (T (PatternTuple pa), T (PatternTuple pb), T (PatternTuple pc))
forall a b c. T (a, b, c) -> (T a, T b, T c)
unzip3

type instance Decomposed f (pa,pb,pc) =
        (Decomposed f pa, Decomposed f pb, Decomposed f pc)
type instance PatternTuple (pa,pb,pc) =
        (PatternTuple pa, PatternTuple pb, PatternTuple pc)


instance (Compose a, Compose b, Compose c, Compose d) => Compose (a,b,c,d) where
   type Composed (a,b,c,d) = (Composed a, Composed b, Composed c, Composed d)
   compose :: (a, b, c, d) -> T (Composed (a, b, c, d))
compose (a
a,b
b,c
c,d
d) = T (Composed a)
-> T (Composed b)
-> T (Composed c)
-> T (Composed d)
-> T (Composed a, Composed b, Composed c, Composed d)
forall a b c d. T a -> T b -> T c -> T d -> T (a, b, c, d)
zip4 (a -> T (Composed a)
forall multituple.
Compose multituple =>
multituple -> T (Composed multituple)
compose a
a) (b -> T (Composed b)
forall multituple.
Compose multituple =>
multituple -> T (Composed multituple)
compose b
b) (c -> T (Composed c)
forall multituple.
Compose multituple =>
multituple -> T (Composed multituple)
compose c
c) (d -> T (Composed d)
forall multituple.
Compose multituple =>
multituple -> T (Composed multituple)
compose d
d)

instance
   (Decompose pa, Decompose pb, Decompose pc, Decompose pd) =>
      Decompose (pa,pb,pc,pd) where
   decompose :: (pa, pb, pc, pd)
-> T (PatternTuple (pa, pb, pc, pd))
-> Decomposed T (pa, pb, pc, pd)
decompose (pa
pa,pb
pb,pc
pc,pd
pd) T (PatternTuple (pa, pb, pc, pd))
x =
      case T (PatternTuple pa, PatternTuple pb, PatternTuple pc,
   PatternTuple pd)
-> (T (PatternTuple pa), T (PatternTuple pb), T (PatternTuple pc),
    T (PatternTuple pd))
forall a b c d. T (a, b, c, d) -> (T a, T b, T c, T d)
unzip4 T (PatternTuple pa, PatternTuple pb, PatternTuple pc,
   PatternTuple pd)
T (PatternTuple (pa, pb, pc, pd))
x of
         (T (PatternTuple pa)
a,T (PatternTuple pb)
b,T (PatternTuple pc)
c,T (PatternTuple pd)
d) ->
            (pa -> T (PatternTuple pa) -> Decomposed T pa
forall pattern.
Decompose pattern =>
pattern -> T (PatternTuple pattern) -> Decomposed T pattern
decompose pa
pa T (PatternTuple pa)
a, pb -> T (PatternTuple pb) -> Decomposed T pb
forall pattern.
Decompose pattern =>
pattern -> T (PatternTuple pattern) -> Decomposed T pattern
decompose pb
pb T (PatternTuple pb)
b, pc -> T (PatternTuple pc) -> Decomposed T pc
forall pattern.
Decompose pattern =>
pattern -> T (PatternTuple pattern) -> Decomposed T pattern
decompose pc
pc T (PatternTuple pc)
c, pd -> T (PatternTuple pd) -> Decomposed T pd
forall pattern.
Decompose pattern =>
pattern -> T (PatternTuple pattern) -> Decomposed T pattern
decompose pd
pd T (PatternTuple pd)
d)
type instance Decomposed f (pa,pb,pc,pd) =
        (Decomposed f pa, Decomposed f pb, Decomposed f pc, Decomposed f pd)
type instance PatternTuple (pa,pb,pc,pd) =
        (PatternTuple pa, PatternTuple pb, PatternTuple pc, PatternTuple pd)


instance (Compose tuple) => Compose (StoreTuple.Tuple tuple) where
   type Composed (StoreTuple.Tuple tuple) = StoreTuple.Tuple (Composed tuple)
   compose :: Tuple tuple -> T (Composed (Tuple tuple))
compose = T (Composed tuple) -> T (Tuple (Composed tuple))
forall tuple. T tuple -> T (Tuple tuple)
tuple (T (Composed tuple) -> T (Tuple (Composed tuple)))
-> (Tuple tuple -> T (Composed tuple))
-> Tuple tuple
-> T (Tuple (Composed tuple))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. tuple -> T (Composed tuple)
forall multituple.
Compose multituple =>
multituple -> T (Composed multituple)
compose (tuple -> T (Composed tuple))
-> (Tuple tuple -> tuple) -> Tuple tuple -> T (Composed tuple)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tuple tuple -> tuple
forall a. Tuple a -> a
StoreTuple.getTuple

instance (Decompose p) => Decompose (StoreTuple.Tuple p) where
   decompose :: Tuple p -> T (PatternTuple (Tuple p)) -> Decomposed T (Tuple p)
decompose (StoreTuple.Tuple p
p) = Decomposed T p -> Tuple (Decomposed T p)
forall a. a -> Tuple a
StoreTuple.Tuple (Decomposed T p -> Tuple (Decomposed T p))
-> (T (Tuple (PatternTuple p)) -> Decomposed T p)
-> T (Tuple (PatternTuple p))
-> Tuple (Decomposed T p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p -> T (PatternTuple p) -> Decomposed T p
forall pattern.
Decompose pattern =>
pattern -> T (PatternTuple pattern) -> Decomposed T pattern
decompose p
p (T (PatternTuple p) -> Decomposed T p)
-> (T (Tuple (PatternTuple p)) -> T (PatternTuple p))
-> T (Tuple (PatternTuple p))
-> Decomposed T p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T (Tuple (PatternTuple p)) -> T (PatternTuple p)
forall tuple. T (Tuple tuple) -> T tuple
untuple

type instance Decomposed f (StoreTuple.Tuple p) =
                  StoreTuple.Tuple (Decomposed f p)
type instance PatternTuple (StoreTuple.Tuple p) =
                  StoreTuple.Tuple (PatternTuple p)


instance (Compose a) => Compose (Tagged tag a) where
   type Composed (Tagged tag a) = Tagged tag (Composed a)
   compose :: Tagged tag a -> T (Composed (Tagged tag a))
compose = T (Composed a) -> T (Tagged tag (Composed a))
forall a tag. T a -> T (Tagged tag a)
tag (T (Composed a) -> T (Tagged tag (Composed a)))
-> (Tagged tag a -> T (Composed a))
-> Tagged tag a
-> T (Tagged tag (Composed a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> T (Composed a)
forall multituple.
Compose multituple =>
multituple -> T (Composed multituple)
compose (a -> T (Composed a))
-> (Tagged tag a -> a) -> Tagged tag a -> T (Composed a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tagged tag a -> a
forall {k} (s :: k) b. Tagged s b -> b
unTagged

instance (Decompose pa) => Decompose (Tagged tag pa) where
   decompose :: Tagged tag pa
-> T (PatternTuple (Tagged tag pa)) -> Decomposed T (Tagged tag pa)
decompose (Tagged pa
p) = Decomposed T pa -> Tagged tag (Decomposed T pa)
forall {k} (s :: k) b. b -> Tagged s b
Tagged (Decomposed T pa -> Tagged tag (Decomposed T pa))
-> (T (Tagged tag (PatternTuple pa)) -> Decomposed T pa)
-> T (Tagged tag (PatternTuple pa))
-> Tagged tag (Decomposed T pa)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. pa -> T (PatternTuple pa) -> Decomposed T pa
forall pattern.
Decompose pattern =>
pattern -> T (PatternTuple pattern) -> Decomposed T pattern
decompose pa
p (T (PatternTuple pa) -> Decomposed T pa)
-> (T (Tagged tag (PatternTuple pa)) -> T (PatternTuple pa))
-> T (Tagged tag (PatternTuple pa))
-> Decomposed T pa
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T (Tagged tag (PatternTuple pa)) -> T (PatternTuple pa)
forall tag a. T (Tagged tag a) -> T a
untag

type instance Decomposed f (Tagged tag pa) = Tagged tag (Decomposed f pa)
type instance PatternTuple (Tagged tag pa) = Tagged tag (PatternTuple pa)


instance (Compose a) => Compose (Complex a) where
   type Composed (Complex a) = Complex (Composed a)
   compose :: Complex a -> T (Composed (Complex a))
compose (a
a:+a
b) = T (Composed a) -> T (Composed a) -> T (Complex (Composed a))
forall a. T a -> T a -> T (Complex a)
consComplex (a -> T (Composed a)
forall multituple.
Compose multituple =>
multituple -> T (Composed multituple)
compose a
a) (a -> T (Composed a)
forall multituple.
Compose multituple =>
multituple -> T (Composed multituple)
compose a
b)

instance (Decompose pa) => Decompose (Complex pa) where
   decompose :: Complex pa
-> T (PatternTuple (Complex pa)) -> Decomposed T (Complex pa)
decompose (pa
pa:+pa
pb) =
      (Decomposed T pa -> Decomposed T pa -> Complex (Decomposed T pa))
-> (Decomposed T pa, Decomposed T pa) -> Complex (Decomposed T pa)
forall a b c. (a -> b -> c) -> (a, b) -> c
Tup.uncurry Decomposed T pa -> Decomposed T pa -> Complex (Decomposed T pa)
forall a. a -> a -> Complex a
(:+) ((Decomposed T pa, Decomposed T pa) -> Complex (Decomposed T pa))
-> (T (Complex (PatternTuple pa))
    -> (Decomposed T pa, Decomposed T pa))
-> T (Complex (PatternTuple pa))
-> Complex (Decomposed T pa)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      (T (PatternTuple pa) -> Decomposed T pa,
 T (PatternTuple pa) -> Decomposed T pa)
-> (T (PatternTuple pa), T (PatternTuple pa))
-> (Decomposed T pa, Decomposed T pa)
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
TupleHT.mapPair (pa -> T (PatternTuple pa) -> Decomposed T pa
forall pattern.
Decompose pattern =>
pattern -> T (PatternTuple pattern) -> Decomposed T pattern
decompose pa
pa, pa -> T (PatternTuple pa) -> Decomposed T pa
forall pattern.
Decompose pattern =>
pattern -> T (PatternTuple pattern) -> Decomposed T pattern
decompose pa
pb) ((T (PatternTuple pa), T (PatternTuple pa))
 -> (Decomposed T pa, Decomposed T pa))
-> (T (Complex (PatternTuple pa))
    -> (T (PatternTuple pa), T (PatternTuple pa)))
-> T (Complex (PatternTuple pa))
-> (Decomposed T pa, Decomposed T pa)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T (Complex (PatternTuple pa))
-> (T (PatternTuple pa), T (PatternTuple pa))
forall a. T (Complex a) -> (T a, T a)
deconsComplex

type instance Decomposed f (Complex pa) = Complex (Decomposed f pa)
type instance PatternTuple (Complex pa) = Complex (PatternTuple pa)

realPart, imagPart :: T (Complex a) -> T a
realPart :: forall a. T (Complex a) -> T a
realPart (Cons (Repr a
a:+Repr a
_)) = Repr a -> T a
forall a. Repr a -> T a
Cons Repr a
a
imagPart :: forall a. T (Complex a) -> T a
imagPart (Cons (Repr a
_:+Repr a
b)) = Repr a -> T a
forall a. Repr a -> T a
Cons Repr a
b



lift1 :: (Repr a -> Repr b) -> T a -> T b
lift1 :: forall a b. (Repr a -> Repr b) -> T a -> T b
lift1 Repr a -> Repr b
f (Cons Repr a
a) = Repr b -> T b
forall a. Repr a -> T a
Cons (Repr b -> T b) -> Repr b -> T b
forall a b. (a -> b) -> a -> b
$ Repr a -> Repr b
f Repr a
a

liftM0 ::
   (Monad m) =>
   m (Repr a) ->
   m (T a)
liftM0 :: forall (m :: * -> *) a. Monad m => m (Repr a) -> m (T a)
liftM0 m (Repr a)
f = (Repr a -> T a) -> m (Repr a) -> m (T a)
forall (m :: * -> *) a r. Monad m => (a -> r) -> m a -> m r
Monad.lift Repr a -> T a
forall a. Repr a -> T a
Cons m (Repr a)
f

liftM ::
   (Monad m) =>
   (Repr a -> m (Repr b)) ->
   T a -> m (T b)
liftM :: forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Repr a -> m (Repr b)
f (Cons Repr a
a) = (Repr b -> T b) -> m (Repr b) -> m (T b)
forall (m :: * -> *) a r. Monad m => (a -> r) -> m a -> m r
Monad.lift Repr b -> T b
forall a. Repr a -> T a
Cons (m (Repr b) -> m (T b)) -> m (Repr b) -> m (T b)
forall a b. (a -> b) -> a -> b
$ Repr a -> m (Repr b)
f Repr a
a

liftM2 ::
   (Monad m) =>
   (Repr a -> Repr b -> m (Repr c)) ->
   T a -> T b -> m (T c)
liftM2 :: forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Repr a -> Repr b -> m (Repr c)
f (Cons Repr a
a) (Cons Repr b
b) = (Repr c -> T c) -> m (Repr c) -> m (T c)
forall (m :: * -> *) a r. Monad m => (a -> r) -> m a -> m r
Monad.lift Repr c -> T c
forall a. Repr a -> T a
Cons (m (Repr c) -> m (T c)) -> m (Repr c) -> m (T c)
forall a b. (a -> b) -> a -> b
$ Repr a -> Repr b -> m (Repr c)
f Repr a
a Repr b
b

liftM3 ::
   (Monad m) =>
   (Repr a -> Repr b -> Repr c ->
    m (Repr d)) ->
   T a -> T b -> T c -> m (T d)
liftM3 :: forall (m :: * -> *) a b c d.
Monad m =>
(Repr a -> Repr b -> Repr c -> m (Repr d))
-> T a -> T b -> T c -> m (T d)
liftM3 Repr a -> Repr b -> Repr c -> m (Repr d)
f (Cons Repr a
a) (Cons Repr b
b) (Cons Repr c
c) = (Repr d -> T d) -> m (Repr d) -> m (T d)
forall (m :: * -> *) a r. Monad m => (a -> r) -> m a -> m r
Monad.lift Repr d -> T d
forall a. Repr a -> T a
Cons (m (Repr d) -> m (T d)) -> m (Repr d) -> m (T d)
forall a b. (a -> b) -> a -> b
$ Repr a -> Repr b -> Repr c -> m (Repr d)
f Repr a
a Repr b
b Repr c
c


instance (C a) => Tuple.Zero (T a) where
   zero :: T a
zero = T a
forall a. C a => T a
zero

instance (C a) => Tuple.Undefined (T a) where
   undef :: T a
undef = T a
forall a. C a => T a
undef

instance (C a) => Tuple.Phi (T a) where
   phi :: forall r. BasicBlock -> T a -> CodeGenFunction r (T a)
phi = BasicBlock -> T a -> CodeGenFunction r (T a)
forall r. BasicBlock -> T a -> CodeGenFunction r (T a)
forall a r. C a => BasicBlock -> T a -> CodeGenFunction r (T a)
phi
   addPhi :: forall r. BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhi = BasicBlock -> T a -> T a -> CodeGenFunction r ()
forall r. BasicBlock -> T a -> T a -> CodeGenFunction r ()
forall a r. C a => BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhi


class (C a) => IntegerConstant a where
   fromInteger' :: Integer -> T a

class (IntegerConstant a) => RationalConstant a where
   fromRational' :: Rational -> T a

instance IntegerConstant Float  where fromInteger' :: Integer -> T Float
fromInteger' = Value Float -> T Float
Repr Float -> T Float
forall a. Repr a -> T a
Cons (Value Float -> T Float)
-> (Integer -> Value Float) -> Integer -> T Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstValue Float -> Value Float
forall a. ConstValue a -> Value a
LLVM.value (ConstValue Float -> Value Float)
-> (Integer -> ConstValue Float) -> Integer -> Value Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ConstValue Float
forall a. IntegerConstant a => Integer -> ConstValue a
SoV.constFromInteger
instance IntegerConstant Double where fromInteger' :: Integer -> T Double
fromInteger' = Value Double -> T Double
Repr Double -> T Double
forall a. Repr a -> T a
Cons (Value Double -> T Double)
-> (Integer -> Value Double) -> Integer -> T Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstValue Double -> Value Double
forall a. ConstValue a -> Value a
LLVM.value (ConstValue Double -> Value Double)
-> (Integer -> ConstValue Double) -> Integer -> Value Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ConstValue Double
forall a. IntegerConstant a => Integer -> ConstValue a
SoV.constFromInteger

instance IntegerConstant Word where fromInteger' :: Integer -> T Word
fromInteger' = Value Word -> T Word
Repr Word -> T Word
forall a. Repr a -> T a
Cons (Value Word -> T Word)
-> (Integer -> Value Word) -> Integer -> T Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstValue Word -> Value Word
forall a. ConstValue a -> Value a
LLVM.value (ConstValue Word -> Value Word)
-> (Integer -> ConstValue Word) -> Integer -> Value Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ConstValue Word
forall a. IntegerConstant a => Integer -> ConstValue a
SoV.constFromInteger
instance IntegerConstant Word8 where fromInteger' :: Integer -> T Word8
fromInteger' = Value Word8 -> T Word8
Repr Word8 -> T Word8
forall a. Repr a -> T a
Cons (Value Word8 -> T Word8)
-> (Integer -> Value Word8) -> Integer -> T Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstValue Word8 -> Value Word8
forall a. ConstValue a -> Value a
LLVM.value (ConstValue Word8 -> Value Word8)
-> (Integer -> ConstValue Word8) -> Integer -> Value Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ConstValue Word8
forall a. IntegerConstant a => Integer -> ConstValue a
SoV.constFromInteger
instance IntegerConstant Word16 where fromInteger' :: Integer -> T Word16
fromInteger' = Value Word16 -> T Word16
Repr Word16 -> T Word16
forall a. Repr a -> T a
Cons (Value Word16 -> T Word16)
-> (Integer -> Value Word16) -> Integer -> T Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstValue Word16 -> Value Word16
forall a. ConstValue a -> Value a
LLVM.value (ConstValue Word16 -> Value Word16)
-> (Integer -> ConstValue Word16) -> Integer -> Value Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ConstValue Word16
forall a. IntegerConstant a => Integer -> ConstValue a
SoV.constFromInteger
instance IntegerConstant Word32 where fromInteger' :: Integer -> T Word32
fromInteger' = Value Word32 -> T Word32
Repr Word32 -> T Word32
forall a. Repr a -> T a
Cons (Value Word32 -> T Word32)
-> (Integer -> Value Word32) -> Integer -> T Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstValue Word32 -> Value Word32
forall a. ConstValue a -> Value a
LLVM.value (ConstValue Word32 -> Value Word32)
-> (Integer -> ConstValue Word32) -> Integer -> Value Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ConstValue Word32
forall a. IntegerConstant a => Integer -> ConstValue a
SoV.constFromInteger
instance IntegerConstant Word64 where fromInteger' :: Integer -> T Word64
fromInteger' = Value Word64 -> T Word64
Repr Word64 -> T Word64
forall a. Repr a -> T a
Cons (Value Word64 -> T Word64)
-> (Integer -> Value Word64) -> Integer -> T Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstValue Word64 -> Value Word64
forall a. ConstValue a -> Value a
LLVM.value (ConstValue Word64 -> Value Word64)
-> (Integer -> ConstValue Word64) -> Integer -> Value Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ConstValue Word64
forall a. IntegerConstant a => Integer -> ConstValue a
SoV.constFromInteger

instance IntegerConstant Int where fromInteger' :: Integer -> T Int
fromInteger' = Value Int -> T Int
Repr Int -> T Int
forall a. Repr a -> T a
Cons (Value Int -> T Int) -> (Integer -> Value Int) -> Integer -> T Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstValue Int -> Value Int
forall a. ConstValue a -> Value a
LLVM.value (ConstValue Int -> Value Int)
-> (Integer -> ConstValue Int) -> Integer -> Value Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ConstValue Int
forall a. IntegerConstant a => Integer -> ConstValue a
SoV.constFromInteger
instance IntegerConstant Int8 where fromInteger' :: Integer -> T Int8
fromInteger' = Value Int8 -> T Int8
Repr Int8 -> T Int8
forall a. Repr a -> T a
Cons (Value Int8 -> T Int8)
-> (Integer -> Value Int8) -> Integer -> T Int8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstValue Int8 -> Value Int8
forall a. ConstValue a -> Value a
LLVM.value (ConstValue Int8 -> Value Int8)
-> (Integer -> ConstValue Int8) -> Integer -> Value Int8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ConstValue Int8
forall a. IntegerConstant a => Integer -> ConstValue a
SoV.constFromInteger
instance IntegerConstant Int16 where fromInteger' :: Integer -> T Int16
fromInteger' = Value Int16 -> T Int16
Repr Int16 -> T Int16
forall a. Repr a -> T a
Cons (Value Int16 -> T Int16)
-> (Integer -> Value Int16) -> Integer -> T Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstValue Int16 -> Value Int16
forall a. ConstValue a -> Value a
LLVM.value (ConstValue Int16 -> Value Int16)
-> (Integer -> ConstValue Int16) -> Integer -> Value Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ConstValue Int16
forall a. IntegerConstant a => Integer -> ConstValue a
SoV.constFromInteger
instance IntegerConstant Int32 where fromInteger' :: Integer -> T Int32
fromInteger' = Value Int32 -> T Int32
Repr Int32 -> T Int32
forall a. Repr a -> T a
Cons (Value Int32 -> T Int32)
-> (Integer -> Value Int32) -> Integer -> T Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstValue Int32 -> Value Int32
forall a. ConstValue a -> Value a
LLVM.value (ConstValue Int32 -> Value Int32)
-> (Integer -> ConstValue Int32) -> Integer -> Value Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ConstValue Int32
forall a. IntegerConstant a => Integer -> ConstValue a
SoV.constFromInteger
instance IntegerConstant Int64 where fromInteger' :: Integer -> T Int64
fromInteger' = Value Int64 -> T Int64
Repr Int64 -> T Int64
forall a. Repr a -> T a
Cons (Value Int64 -> T Int64)
-> (Integer -> Value Int64) -> Integer -> T Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstValue Int64 -> Value Int64
forall a. ConstValue a -> Value a
LLVM.value (ConstValue Int64 -> Value Int64)
-> (Integer -> ConstValue Int64) -> Integer -> Value Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ConstValue Int64
forall a. IntegerConstant a => Integer -> ConstValue a
SoV.constFromInteger

instance (Dec.Positive n) => IntegerConstant (WordN n) where fromInteger' :: Integer -> T (WordN n)
fromInteger' = Value (WordN n) -> T (WordN n)
Repr (WordN n) -> T (WordN n)
forall a. Repr a -> T a
Cons (Value (WordN n) -> T (WordN n))
-> (Integer -> Value (WordN n)) -> Integer -> T (WordN n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstValue (WordN n) -> Value (WordN n)
forall a. ConstValue a -> Value a
LLVM.value (ConstValue (WordN n) -> Value (WordN n))
-> (Integer -> ConstValue (WordN n)) -> Integer -> Value (WordN n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ConstValue (WordN n)
forall a. IntegerConstant a => Integer -> ConstValue a
SoV.constFromInteger
instance (Dec.Positive n) => IntegerConstant (IntN n) where fromInteger' :: Integer -> T (IntN n)
fromInteger' = Value (IntN n) -> T (IntN n)
Repr (IntN n) -> T (IntN n)
forall a. Repr a -> T a
Cons (Value (IntN n) -> T (IntN n))
-> (Integer -> Value (IntN n)) -> Integer -> T (IntN n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstValue (IntN n) -> Value (IntN n)
forall a. ConstValue a -> Value a
LLVM.value (ConstValue (IntN n) -> Value (IntN n))
-> (Integer -> ConstValue (IntN n)) -> Integer -> Value (IntN n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ConstValue (IntN n)
forall a. IntegerConstant a => Integer -> ConstValue a
SoV.constFromInteger

instance IntegerConstant a => IntegerConstant (Tagged tag a) where
   fromInteger' :: Integer -> T (Tagged tag a)
fromInteger' = T a -> T (Tagged tag a)
forall a tag. T a -> T (Tagged tag a)
tag (T a -> T (Tagged tag a))
-> (Integer -> T a) -> Integer -> T (Tagged tag a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> T a
forall a. IntegerConstant a => Integer -> T a
fromInteger'

instance RationalConstant Float  where fromRational' :: Rational -> T Float
fromRational' = Value Float -> T Float
Repr Float -> T Float
forall a. Repr a -> T a
Cons (Value Float -> T Float)
-> (Rational -> Value Float) -> Rational -> T Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstValue Float -> Value Float
forall a. ConstValue a -> Value a
LLVM.value (ConstValue Float -> Value Float)
-> (Rational -> ConstValue Float) -> Rational -> Value Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> ConstValue Float
forall a. RationalConstant a => Rational -> ConstValue a
SoV.constFromRational
instance RationalConstant Double where fromRational' :: Rational -> T Double
fromRational' = Value Double -> T Double
Repr Double -> T Double
forall a. Repr a -> T a
Cons (Value Double -> T Double)
-> (Rational -> Value Double) -> Rational -> T Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstValue Double -> Value Double
forall a. ConstValue a -> Value a
LLVM.value (ConstValue Double -> Value Double)
-> (Rational -> ConstValue Double) -> Rational -> Value Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> ConstValue Double
forall a. RationalConstant a => Rational -> ConstValue a
SoV.constFromRational

instance RationalConstant a => RationalConstant (Tagged tag a) where
   fromRational' :: Rational -> T (Tagged tag a)
fromRational' = T a -> T (Tagged tag a)
forall a tag. T a -> T (Tagged tag a)
tag (T a -> T (Tagged tag a))
-> (Rational -> T a) -> Rational -> T (Tagged tag a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> T a
forall a. RationalConstant a => Rational -> T a
fromRational'


instance (IntegerConstant a) => A.IntegerConstant (T a) where
   fromInteger' :: Integer -> T a
fromInteger' = Integer -> T a
forall a. IntegerConstant a => Integer -> T a
fromInteger'

instance (RationalConstant a) => A.RationalConstant (T a) where
   fromRational' :: Rational -> T a
fromRational' = Rational -> T a
forall a. RationalConstant a => Rational -> T a
fromRational'


class (C a) => Additive a where
   add :: T a -> T a -> LLVM.CodeGenFunction r (T a)
   sub :: T a -> T a -> LLVM.CodeGenFunction r (T a)
   neg :: T a -> LLVM.CodeGenFunction r (T a)

instance Additive Float where
   add :: forall r. T Float -> T Float -> CodeGenFunction r (T Float)
add = (Repr Float -> Repr Float -> CodeGenFunction r (Repr Float))
-> T Float -> T Float -> CodeGenFunction r (T Float)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Float -> Value Float -> CodeGenFunction r (Value Float)
Repr Float -> Repr Float -> CodeGenFunction r (Repr Float)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.add
   sub :: forall r. T Float -> T Float -> CodeGenFunction r (T Float)
sub = (Repr Float -> Repr Float -> CodeGenFunction r (Repr Float))
-> T Float -> T Float -> CodeGenFunction r (T Float)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Float -> Value Float -> CodeGenFunction r (Value Float)
Repr Float -> Repr Float -> CodeGenFunction r (Repr Float)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.sub
   neg :: forall r. T Float -> CodeGenFunction r (T Float)
neg = (Repr Float -> CodeGenFunction r (Repr Float))
-> T Float -> CodeGenFunction r (T Float)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Float -> CodeGenFunction r (Value Float)
Repr Float -> CodeGenFunction r (Repr Float)
forall a r.
IsArithmetic a =>
Value a -> CodeGenFunction r (Value a)
LLVM.neg

instance Additive Double where
   add :: forall r. T Double -> T Double -> CodeGenFunction r (T Double)
add = (Repr Double -> Repr Double -> CodeGenFunction r (Repr Double))
-> T Double -> T Double -> CodeGenFunction r (T Double)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Double -> Value Double -> CodeGenFunction r (Value Double)
Repr Double -> Repr Double -> CodeGenFunction r (Repr Double)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.add
   sub :: forall r. T Double -> T Double -> CodeGenFunction r (T Double)
sub = (Repr Double -> Repr Double -> CodeGenFunction r (Repr Double))
-> T Double -> T Double -> CodeGenFunction r (T Double)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Double -> Value Double -> CodeGenFunction r (Value Double)
Repr Double -> Repr Double -> CodeGenFunction r (Repr Double)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.sub
   neg :: forall r. T Double -> CodeGenFunction r (T Double)
neg = (Repr Double -> CodeGenFunction r (Repr Double))
-> T Double -> CodeGenFunction r (T Double)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Double -> CodeGenFunction r (Value Double)
Repr Double -> CodeGenFunction r (Repr Double)
forall a r.
IsArithmetic a =>
Value a -> CodeGenFunction r (Value a)
LLVM.neg

instance Additive Word where
   add :: forall r. T Word -> T Word -> CodeGenFunction r (T Word)
add = (Repr Word -> Repr Word -> CodeGenFunction r (Repr Word))
-> T Word -> T Word -> CodeGenFunction r (T Word)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word -> Value Word -> CodeGenFunction r (Value Word)
Repr Word -> Repr Word -> CodeGenFunction r (Repr Word)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.add
   sub :: forall r. T Word -> T Word -> CodeGenFunction r (T Word)
sub = (Repr Word -> Repr Word -> CodeGenFunction r (Repr Word))
-> T Word -> T Word -> CodeGenFunction r (T Word)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word -> Value Word -> CodeGenFunction r (Value Word)
Repr Word -> Repr Word -> CodeGenFunction r (Repr Word)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.sub
   neg :: forall r. T Word -> CodeGenFunction r (T Word)
neg = (Repr Word -> CodeGenFunction r (Repr Word))
-> T Word -> CodeGenFunction r (T Word)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Word -> CodeGenFunction r (Value Word)
Repr Word -> CodeGenFunction r (Repr Word)
forall a r.
IsArithmetic a =>
Value a -> CodeGenFunction r (Value a)
LLVM.neg

instance Additive Word8 where
   add :: forall r. T Word8 -> T Word8 -> CodeGenFunction r (T Word8)
add = (Repr Word8 -> Repr Word8 -> CodeGenFunction r (Repr Word8))
-> T Word8 -> T Word8 -> CodeGenFunction r (T Word8)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word8 -> Value Word8 -> CodeGenFunction r (Value Word8)
Repr Word8 -> Repr Word8 -> CodeGenFunction r (Repr Word8)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.add
   sub :: forall r. T Word8 -> T Word8 -> CodeGenFunction r (T Word8)
sub = (Repr Word8 -> Repr Word8 -> CodeGenFunction r (Repr Word8))
-> T Word8 -> T Word8 -> CodeGenFunction r (T Word8)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word8 -> Value Word8 -> CodeGenFunction r (Value Word8)
Repr Word8 -> Repr Word8 -> CodeGenFunction r (Repr Word8)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.sub
   neg :: forall r. T Word8 -> CodeGenFunction r (T Word8)
neg = (Repr Word8 -> CodeGenFunction r (Repr Word8))
-> T Word8 -> CodeGenFunction r (T Word8)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Word8 -> CodeGenFunction r (Value Word8)
Repr Word8 -> CodeGenFunction r (Repr Word8)
forall a r.
IsArithmetic a =>
Value a -> CodeGenFunction r (Value a)
LLVM.neg

instance Additive Word16 where
   add :: forall r. T Word16 -> T Word16 -> CodeGenFunction r (T Word16)
add = (Repr Word16 -> Repr Word16 -> CodeGenFunction r (Repr Word16))
-> T Word16 -> T Word16 -> CodeGenFunction r (T Word16)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word16 -> Value Word16 -> CodeGenFunction r (Value Word16)
Repr Word16 -> Repr Word16 -> CodeGenFunction r (Repr Word16)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.add
   sub :: forall r. T Word16 -> T Word16 -> CodeGenFunction r (T Word16)
sub = (Repr Word16 -> Repr Word16 -> CodeGenFunction r (Repr Word16))
-> T Word16 -> T Word16 -> CodeGenFunction r (T Word16)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word16 -> Value Word16 -> CodeGenFunction r (Value Word16)
Repr Word16 -> Repr Word16 -> CodeGenFunction r (Repr Word16)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.sub
   neg :: forall r. T Word16 -> CodeGenFunction r (T Word16)
neg = (Repr Word16 -> CodeGenFunction r (Repr Word16))
-> T Word16 -> CodeGenFunction r (T Word16)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Word16 -> CodeGenFunction r (Value Word16)
Repr Word16 -> CodeGenFunction r (Repr Word16)
forall a r.
IsArithmetic a =>
Value a -> CodeGenFunction r (Value a)
LLVM.neg

instance Additive Word32 where
   add :: forall r. T Word32 -> T Word32 -> CodeGenFunction r (T Word32)
add = (Repr Word32 -> Repr Word32 -> CodeGenFunction r (Repr Word32))
-> T Word32 -> T Word32 -> CodeGenFunction r (T Word32)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word32 -> Value Word32 -> CodeGenFunction r (Value Word32)
Repr Word32 -> Repr Word32 -> CodeGenFunction r (Repr Word32)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.add
   sub :: forall r. T Word32 -> T Word32 -> CodeGenFunction r (T Word32)
sub = (Repr Word32 -> Repr Word32 -> CodeGenFunction r (Repr Word32))
-> T Word32 -> T Word32 -> CodeGenFunction r (T Word32)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word32 -> Value Word32 -> CodeGenFunction r (Value Word32)
Repr Word32 -> Repr Word32 -> CodeGenFunction r (Repr Word32)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.sub
   neg :: forall r. T Word32 -> CodeGenFunction r (T Word32)
neg = (Repr Word32 -> CodeGenFunction r (Repr Word32))
-> T Word32 -> CodeGenFunction r (T Word32)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Word32 -> CodeGenFunction r (Value Word32)
Repr Word32 -> CodeGenFunction r (Repr Word32)
forall a r.
IsArithmetic a =>
Value a -> CodeGenFunction r (Value a)
LLVM.neg

instance Additive Word64 where
   add :: forall r. T Word64 -> T Word64 -> CodeGenFunction r (T Word64)
add = (Repr Word64 -> Repr Word64 -> CodeGenFunction r (Repr Word64))
-> T Word64 -> T Word64 -> CodeGenFunction r (T Word64)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word64 -> Value Word64 -> CodeGenFunction r (Value Word64)
Repr Word64 -> Repr Word64 -> CodeGenFunction r (Repr Word64)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.add
   sub :: forall r. T Word64 -> T Word64 -> CodeGenFunction r (T Word64)
sub = (Repr Word64 -> Repr Word64 -> CodeGenFunction r (Repr Word64))
-> T Word64 -> T Word64 -> CodeGenFunction r (T Word64)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word64 -> Value Word64 -> CodeGenFunction r (Value Word64)
Repr Word64 -> Repr Word64 -> CodeGenFunction r (Repr Word64)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.sub
   neg :: forall r. T Word64 -> CodeGenFunction r (T Word64)
neg = (Repr Word64 -> CodeGenFunction r (Repr Word64))
-> T Word64 -> CodeGenFunction r (T Word64)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Word64 -> CodeGenFunction r (Value Word64)
Repr Word64 -> CodeGenFunction r (Repr Word64)
forall a r.
IsArithmetic a =>
Value a -> CodeGenFunction r (Value a)
LLVM.neg

instance Additive Int where
   add :: forall r. T Int -> T Int -> CodeGenFunction r (T Int)
add = (Repr Int -> Repr Int -> CodeGenFunction r (Repr Int))
-> T Int -> T Int -> CodeGenFunction r (T Int)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int -> Value Int -> CodeGenFunction r (Value Int)
Repr Int -> Repr Int -> CodeGenFunction r (Repr Int)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.add
   sub :: forall r. T Int -> T Int -> CodeGenFunction r (T Int)
sub = (Repr Int -> Repr Int -> CodeGenFunction r (Repr Int))
-> T Int -> T Int -> CodeGenFunction r (T Int)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int -> Value Int -> CodeGenFunction r (Value Int)
Repr Int -> Repr Int -> CodeGenFunction r (Repr Int)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.sub
   neg :: forall r. T Int -> CodeGenFunction r (T Int)
neg = (Repr Int -> CodeGenFunction r (Repr Int))
-> T Int -> CodeGenFunction r (T Int)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Int -> CodeGenFunction r (Value Int)
Repr Int -> CodeGenFunction r (Repr Int)
forall a r.
IsArithmetic a =>
Value a -> CodeGenFunction r (Value a)
LLVM.neg

instance Additive Int8 where
   add :: forall r. T Int8 -> T Int8 -> CodeGenFunction r (T Int8)
add = (Repr Int8 -> Repr Int8 -> CodeGenFunction r (Repr Int8))
-> T Int8 -> T Int8 -> CodeGenFunction r (T Int8)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int8 -> Value Int8 -> CodeGenFunction r (Value Int8)
Repr Int8 -> Repr Int8 -> CodeGenFunction r (Repr Int8)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.add
   sub :: forall r. T Int8 -> T Int8 -> CodeGenFunction r (T Int8)
sub = (Repr Int8 -> Repr Int8 -> CodeGenFunction r (Repr Int8))
-> T Int8 -> T Int8 -> CodeGenFunction r (T Int8)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int8 -> Value Int8 -> CodeGenFunction r (Value Int8)
Repr Int8 -> Repr Int8 -> CodeGenFunction r (Repr Int8)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.sub
   neg :: forall r. T Int8 -> CodeGenFunction r (T Int8)
neg = (Repr Int8 -> CodeGenFunction r (Repr Int8))
-> T Int8 -> CodeGenFunction r (T Int8)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Int8 -> CodeGenFunction r (Value Int8)
Repr Int8 -> CodeGenFunction r (Repr Int8)
forall a r.
IsArithmetic a =>
Value a -> CodeGenFunction r (Value a)
LLVM.neg

instance Additive Int16 where
   add :: forall r. T Int16 -> T Int16 -> CodeGenFunction r (T Int16)
add = (Repr Int16 -> Repr Int16 -> CodeGenFunction r (Repr Int16))
-> T Int16 -> T Int16 -> CodeGenFunction r (T Int16)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int16 -> Value Int16 -> CodeGenFunction r (Value Int16)
Repr Int16 -> Repr Int16 -> CodeGenFunction r (Repr Int16)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.add
   sub :: forall r. T Int16 -> T Int16 -> CodeGenFunction r (T Int16)
sub = (Repr Int16 -> Repr Int16 -> CodeGenFunction r (Repr Int16))
-> T Int16 -> T Int16 -> CodeGenFunction r (T Int16)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int16 -> Value Int16 -> CodeGenFunction r (Value Int16)
Repr Int16 -> Repr Int16 -> CodeGenFunction r (Repr Int16)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.sub
   neg :: forall r. T Int16 -> CodeGenFunction r (T Int16)
neg = (Repr Int16 -> CodeGenFunction r (Repr Int16))
-> T Int16 -> CodeGenFunction r (T Int16)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Int16 -> CodeGenFunction r (Value Int16)
Repr Int16 -> CodeGenFunction r (Repr Int16)
forall a r.
IsArithmetic a =>
Value a -> CodeGenFunction r (Value a)
LLVM.neg

instance Additive Int32 where
   add :: forall r. T Int32 -> T Int32 -> CodeGenFunction r (T Int32)
add = (Repr Int32 -> Repr Int32 -> CodeGenFunction r (Repr Int32))
-> T Int32 -> T Int32 -> CodeGenFunction r (T Int32)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int32 -> Value Int32 -> CodeGenFunction r (Value Int32)
Repr Int32 -> Repr Int32 -> CodeGenFunction r (Repr Int32)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.add
   sub :: forall r. T Int32 -> T Int32 -> CodeGenFunction r (T Int32)
sub = (Repr Int32 -> Repr Int32 -> CodeGenFunction r (Repr Int32))
-> T Int32 -> T Int32 -> CodeGenFunction r (T Int32)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int32 -> Value Int32 -> CodeGenFunction r (Value Int32)
Repr Int32 -> Repr Int32 -> CodeGenFunction r (Repr Int32)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.sub
   neg :: forall r. T Int32 -> CodeGenFunction r (T Int32)
neg = (Repr Int32 -> CodeGenFunction r (Repr Int32))
-> T Int32 -> CodeGenFunction r (T Int32)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Int32 -> CodeGenFunction r (Value Int32)
Repr Int32 -> CodeGenFunction r (Repr Int32)
forall a r.
IsArithmetic a =>
Value a -> CodeGenFunction r (Value a)
LLVM.neg

instance Additive Int64 where
   add :: forall r. T Int64 -> T Int64 -> CodeGenFunction r (T Int64)
add = (Repr Int64 -> Repr Int64 -> CodeGenFunction r (Repr Int64))
-> T Int64 -> T Int64 -> CodeGenFunction r (T Int64)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int64 -> Value Int64 -> CodeGenFunction r (Value Int64)
Repr Int64 -> Repr Int64 -> CodeGenFunction r (Repr Int64)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.add
   sub :: forall r. T Int64 -> T Int64 -> CodeGenFunction r (T Int64)
sub = (Repr Int64 -> Repr Int64 -> CodeGenFunction r (Repr Int64))
-> T Int64 -> T Int64 -> CodeGenFunction r (T Int64)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int64 -> Value Int64 -> CodeGenFunction r (Value Int64)
Repr Int64 -> Repr Int64 -> CodeGenFunction r (Repr Int64)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.sub
   neg :: forall r. T Int64 -> CodeGenFunction r (T Int64)
neg = (Repr Int64 -> CodeGenFunction r (Repr Int64))
-> T Int64 -> CodeGenFunction r (T Int64)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Int64 -> CodeGenFunction r (Value Int64)
Repr Int64 -> CodeGenFunction r (Repr Int64)
forall a r.
IsArithmetic a =>
Value a -> CodeGenFunction r (Value a)
LLVM.neg

instance (Dec.Positive n) => Additive (WordN n) where
   add :: forall r.
T (WordN n) -> T (WordN n) -> CodeGenFunction r (T (WordN n))
add = (Repr (WordN n)
 -> Repr (WordN n) -> CodeGenFunction r (Repr (WordN n)))
-> T (WordN n) -> T (WordN n) -> CodeGenFunction r (T (WordN n))
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value (WordN n)
-> Value (WordN n) -> CodeGenFunction r (Value (WordN n))
Repr (WordN n)
-> Repr (WordN n) -> CodeGenFunction r (Repr (WordN n))
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.add
   sub :: forall r.
T (WordN n) -> T (WordN n) -> CodeGenFunction r (T (WordN n))
sub = (Repr (WordN n)
 -> Repr (WordN n) -> CodeGenFunction r (Repr (WordN n)))
-> T (WordN n) -> T (WordN n) -> CodeGenFunction r (T (WordN n))
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value (WordN n)
-> Value (WordN n) -> CodeGenFunction r (Value (WordN n))
Repr (WordN n)
-> Repr (WordN n) -> CodeGenFunction r (Repr (WordN n))
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.sub
   neg :: forall r. T (WordN n) -> CodeGenFunction r (T (WordN n))
neg = (Repr (WordN n) -> CodeGenFunction r (Repr (WordN n)))
-> T (WordN n) -> CodeGenFunction r (T (WordN n))
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value (WordN n) -> CodeGenFunction r (Value (WordN n))
Repr (WordN n) -> CodeGenFunction r (Repr (WordN n))
forall a r.
IsArithmetic a =>
Value a -> CodeGenFunction r (Value a)
LLVM.neg

instance (Dec.Positive n) => Additive (IntN n) where
   add :: forall r.
T (IntN n) -> T (IntN n) -> CodeGenFunction r (T (IntN n))
add = (Repr (IntN n)
 -> Repr (IntN n) -> CodeGenFunction r (Repr (IntN n)))
-> T (IntN n) -> T (IntN n) -> CodeGenFunction r (T (IntN n))
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value (IntN n)
-> Value (IntN n) -> CodeGenFunction r (Value (IntN n))
Repr (IntN n) -> Repr (IntN n) -> CodeGenFunction r (Repr (IntN n))
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.add
   sub :: forall r.
T (IntN n) -> T (IntN n) -> CodeGenFunction r (T (IntN n))
sub = (Repr (IntN n)
 -> Repr (IntN n) -> CodeGenFunction r (Repr (IntN n)))
-> T (IntN n) -> T (IntN n) -> CodeGenFunction r (T (IntN n))
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value (IntN n)
-> Value (IntN n) -> CodeGenFunction r (Value (IntN n))
Repr (IntN n) -> Repr (IntN n) -> CodeGenFunction r (Repr (IntN n))
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.sub
   neg :: forall r. T (IntN n) -> CodeGenFunction r (T (IntN n))
neg = (Repr (IntN n) -> CodeGenFunction r (Repr (IntN n)))
-> T (IntN n) -> CodeGenFunction r (T (IntN n))
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value (IntN n) -> CodeGenFunction r (Value (IntN n))
Repr (IntN n) -> CodeGenFunction r (Repr (IntN n))
forall a r.
IsArithmetic a =>
Value a -> CodeGenFunction r (Value a)
LLVM.neg

instance Additive a => Additive (Tagged tag a) where
   add :: forall r.
T (Tagged tag a)
-> T (Tagged tag a) -> CodeGenFunction r (T (Tagged tag a))
add = (T a -> T a -> CodeGenFunction r (T a))
-> T (Tagged tag a)
-> T (Tagged tag a)
-> CodeGenFunction r (T (Tagged tag a))
forall (m :: * -> *) a b c tag.
Monad m =>
(T a -> T b -> m (T c))
-> T (Tagged tag a) -> T (Tagged tag b) -> m (T (Tagged tag c))
liftTaggedM2 T a -> T a -> CodeGenFunction r (T a)
forall a r. Additive a => T a -> T a -> CodeGenFunction r (T a)
forall r. T a -> T a -> CodeGenFunction r (T a)
add
   sub :: forall r.
T (Tagged tag a)
-> T (Tagged tag a) -> CodeGenFunction r (T (Tagged tag a))
sub = (T a -> T a -> CodeGenFunction r (T a))
-> T (Tagged tag a)
-> T (Tagged tag a)
-> CodeGenFunction r (T (Tagged tag a))
forall (m :: * -> *) a b c tag.
Monad m =>
(T a -> T b -> m (T c))
-> T (Tagged tag a) -> T (Tagged tag b) -> m (T (Tagged tag c))
liftTaggedM2 T a -> T a -> CodeGenFunction r (T a)
forall a r. Additive a => T a -> T a -> CodeGenFunction r (T a)
forall r. T a -> T a -> CodeGenFunction r (T a)
sub
   neg :: forall r. T (Tagged tag a) -> CodeGenFunction r (T (Tagged tag a))
neg = (T a -> CodeGenFunction r (T a))
-> T (Tagged tag a) -> CodeGenFunction r (T (Tagged tag a))
forall (m :: * -> *) a b tag.
Monad m =>
(T a -> m (T b)) -> T (Tagged tag a) -> m (T (Tagged tag b))
liftTaggedM T a -> CodeGenFunction r (T a)
forall a r. Additive a => T a -> CodeGenFunction r (T a)
forall r. T a -> CodeGenFunction r (T a)
neg

instance (Additive a) => A.Additive (T a) where
   zero :: T a
zero = T a
forall a. C a => T a
zero
   add :: forall r. T a -> T a -> CodeGenFunction r (T a)
add = T a -> T a -> CodeGenFunction r (T a)
forall a r. Additive a => T a -> T a -> CodeGenFunction r (T a)
forall r. T a -> T a -> CodeGenFunction r (T a)
add
   sub :: forall r. T a -> T a -> CodeGenFunction r (T a)
sub = T a -> T a -> CodeGenFunction r (T a)
forall a r. Additive a => T a -> T a -> CodeGenFunction r (T a)
forall r. T a -> T a -> CodeGenFunction r (T a)
sub
   neg :: forall r. T a -> CodeGenFunction r (T a)
neg = T a -> CodeGenFunction r (T a)
forall a r. Additive a => T a -> CodeGenFunction r (T a)
forall r. T a -> CodeGenFunction r (T a)
neg

inc, dec ::
   (Additive i, IntegerConstant i) => T i -> LLVM.CodeGenFunction r (T i)
inc :: forall i r.
(Additive i, IntegerConstant i) =>
T i -> CodeGenFunction r (T i)
inc T i
x = T i -> T i -> CodeGenFunction r (T i)
forall a r. Additive a => T a -> T a -> CodeGenFunction r (T a)
forall r. T i -> T i -> CodeGenFunction r (T i)
add T i
x T i
forall a. IntegerConstant a => a
A.one
dec :: forall i r.
(Additive i, IntegerConstant i) =>
T i -> CodeGenFunction r (T i)
dec T i
x = T i -> T i -> CodeGenFunction r (T i)
forall a r. Additive a => T a -> T a -> CodeGenFunction r (T a)
forall r. T i -> T i -> CodeGenFunction r (T i)
sub T i
x T i
forall a. IntegerConstant a => a
A.one


class (Additive a) => PseudoRing a where
   mul :: T a -> T a -> LLVM.CodeGenFunction r (T a)

instance PseudoRing Float where mul :: forall r. T Float -> T Float -> CodeGenFunction r (T Float)
mul = (Repr Float -> Repr Float -> CodeGenFunction r (Repr Float))
-> T Float -> T Float -> CodeGenFunction r (T Float)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Float -> Value Float -> CodeGenFunction r (Value Float)
Repr Float -> Repr Float -> CodeGenFunction r (Repr Float)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.mul
instance PseudoRing Double where mul :: forall r. T Double -> T Double -> CodeGenFunction r (T Double)
mul = (Repr Double -> Repr Double -> CodeGenFunction r (Repr Double))
-> T Double -> T Double -> CodeGenFunction r (T Double)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Double -> Value Double -> CodeGenFunction r (Value Double)
Repr Double -> Repr Double -> CodeGenFunction r (Repr Double)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.mul
instance PseudoRing Word where mul :: forall r. T Word -> T Word -> CodeGenFunction r (T Word)
mul = (Repr Word -> Repr Word -> CodeGenFunction r (Repr Word))
-> T Word -> T Word -> CodeGenFunction r (T Word)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word -> Value Word -> CodeGenFunction r (Value Word)
Repr Word -> Repr Word -> CodeGenFunction r (Repr Word)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.mul
instance PseudoRing Word8 where mul :: forall r. T Word8 -> T Word8 -> CodeGenFunction r (T Word8)
mul = (Repr Word8 -> Repr Word8 -> CodeGenFunction r (Repr Word8))
-> T Word8 -> T Word8 -> CodeGenFunction r (T Word8)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word8 -> Value Word8 -> CodeGenFunction r (Value Word8)
Repr Word8 -> Repr Word8 -> CodeGenFunction r (Repr Word8)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.mul
instance PseudoRing Word16 where mul :: forall r. T Word16 -> T Word16 -> CodeGenFunction r (T Word16)
mul = (Repr Word16 -> Repr Word16 -> CodeGenFunction r (Repr Word16))
-> T Word16 -> T Word16 -> CodeGenFunction r (T Word16)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word16 -> Value Word16 -> CodeGenFunction r (Value Word16)
Repr Word16 -> Repr Word16 -> CodeGenFunction r (Repr Word16)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.mul
instance PseudoRing Word32 where mul :: forall r. T Word32 -> T Word32 -> CodeGenFunction r (T Word32)
mul = (Repr Word32 -> Repr Word32 -> CodeGenFunction r (Repr Word32))
-> T Word32 -> T Word32 -> CodeGenFunction r (T Word32)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word32 -> Value Word32 -> CodeGenFunction r (Value Word32)
Repr Word32 -> Repr Word32 -> CodeGenFunction r (Repr Word32)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.mul
instance PseudoRing Word64 where mul :: forall r. T Word64 -> T Word64 -> CodeGenFunction r (T Word64)
mul = (Repr Word64 -> Repr Word64 -> CodeGenFunction r (Repr Word64))
-> T Word64 -> T Word64 -> CodeGenFunction r (T Word64)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word64 -> Value Word64 -> CodeGenFunction r (Value Word64)
Repr Word64 -> Repr Word64 -> CodeGenFunction r (Repr Word64)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.mul
instance PseudoRing Int where mul :: forall r. T Int -> T Int -> CodeGenFunction r (T Int)
mul = (Repr Int -> Repr Int -> CodeGenFunction r (Repr Int))
-> T Int -> T Int -> CodeGenFunction r (T Int)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int -> Value Int -> CodeGenFunction r (Value Int)
Repr Int -> Repr Int -> CodeGenFunction r (Repr Int)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.mul
instance PseudoRing Int8 where mul :: forall r. T Int8 -> T Int8 -> CodeGenFunction r (T Int8)
mul = (Repr Int8 -> Repr Int8 -> CodeGenFunction r (Repr Int8))
-> T Int8 -> T Int8 -> CodeGenFunction r (T Int8)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int8 -> Value Int8 -> CodeGenFunction r (Value Int8)
Repr Int8 -> Repr Int8 -> CodeGenFunction r (Repr Int8)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.mul
instance PseudoRing Int16 where mul :: forall r. T Int16 -> T Int16 -> CodeGenFunction r (T Int16)
mul = (Repr Int16 -> Repr Int16 -> CodeGenFunction r (Repr Int16))
-> T Int16 -> T Int16 -> CodeGenFunction r (T Int16)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int16 -> Value Int16 -> CodeGenFunction r (Value Int16)
Repr Int16 -> Repr Int16 -> CodeGenFunction r (Repr Int16)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.mul
instance PseudoRing Int32 where mul :: forall r. T Int32 -> T Int32 -> CodeGenFunction r (T Int32)
mul = (Repr Int32 -> Repr Int32 -> CodeGenFunction r (Repr Int32))
-> T Int32 -> T Int32 -> CodeGenFunction r (T Int32)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int32 -> Value Int32 -> CodeGenFunction r (Value Int32)
Repr Int32 -> Repr Int32 -> CodeGenFunction r (Repr Int32)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.mul
instance PseudoRing Int64 where mul :: forall r. T Int64 -> T Int64 -> CodeGenFunction r (T Int64)
mul = (Repr Int64 -> Repr Int64 -> CodeGenFunction r (Repr Int64))
-> T Int64 -> T Int64 -> CodeGenFunction r (T Int64)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int64 -> Value Int64 -> CodeGenFunction r (Value Int64)
Repr Int64 -> Repr Int64 -> CodeGenFunction r (Repr Int64)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.mul

instance (PseudoRing a) => PseudoRing (Tagged tag a) where
   mul :: forall r.
T (Tagged tag a)
-> T (Tagged tag a) -> CodeGenFunction r (T (Tagged tag a))
mul = (T a -> T a -> CodeGenFunction r (T a))
-> T (Tagged tag a)
-> T (Tagged tag a)
-> CodeGenFunction r (T (Tagged tag a))
forall (m :: * -> *) a b c tag.
Monad m =>
(T a -> T b -> m (T c))
-> T (Tagged tag a) -> T (Tagged tag b) -> m (T (Tagged tag c))
liftTaggedM2 T a -> T a -> CodeGenFunction r (T a)
forall a r. PseudoRing a => T a -> T a -> CodeGenFunction r (T a)
forall r. T a -> T a -> CodeGenFunction r (T a)
mul

instance (PseudoRing a) => A.PseudoRing (T a) where
   mul :: forall r. T a -> T a -> CodeGenFunction r (T a)
mul = T a -> T a -> CodeGenFunction r (T a)
forall a r. PseudoRing a => T a -> T a -> CodeGenFunction r (T a)
forall r. T a -> T a -> CodeGenFunction r (T a)
mul


class (PseudoRing a) => Field a where
   fdiv :: T a -> T a -> LLVM.CodeGenFunction r (T a)

instance Field Float where
   fdiv :: forall r. T Float -> T Float -> CodeGenFunction r (T Float)
fdiv = (Repr Float -> Repr Float -> CodeGenFunction r (Repr Float))
-> T Float -> T Float -> CodeGenFunction r (T Float)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Float -> Value Float -> CodeGenFunction r (Value Float)
Repr Float -> Repr Float -> CodeGenFunction r (Repr Float)
forall a r.
IsFloating a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.fdiv

instance Field Double where
   fdiv :: forall r. T Double -> T Double -> CodeGenFunction r (T Double)
fdiv = (Repr Double -> Repr Double -> CodeGenFunction r (Repr Double))
-> T Double -> T Double -> CodeGenFunction r (T Double)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Double -> Value Double -> CodeGenFunction r (Value Double)
Repr Double -> Repr Double -> CodeGenFunction r (Repr Double)
forall a r.
IsFloating a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.fdiv

instance (Field a) => Field (Tagged tag a) where
   fdiv :: forall r.
T (Tagged tag a)
-> T (Tagged tag a) -> CodeGenFunction r (T (Tagged tag a))
fdiv = (T a -> T a -> CodeGenFunction r (T a))
-> T (Tagged tag a)
-> T (Tagged tag a)
-> CodeGenFunction r (T (Tagged tag a))
forall (m :: * -> *) a b c tag.
Monad m =>
(T a -> T b -> m (T c))
-> T (Tagged tag a) -> T (Tagged tag b) -> m (T (Tagged tag c))
liftTaggedM2 T a -> T a -> CodeGenFunction r (T a)
forall a r. Field a => T a -> T a -> CodeGenFunction r (T a)
forall r. T a -> T a -> CodeGenFunction r (T a)
fdiv

instance (Field a) => A.Field (T a) where
   fdiv :: forall r. T a -> T a -> CodeGenFunction r (T a)
fdiv = T a -> T a -> CodeGenFunction r (T a)
forall a r. Field a => T a -> T a -> CodeGenFunction r (T a)
forall r. T a -> T a -> CodeGenFunction r (T a)
fdiv


type family Scalar vector
type instance Scalar Float = Float
type instance Scalar Double = Double
type instance Scalar (Tagged tag a) = Tagged tag (Scalar a)
type instance A.Scalar (T a) = T (Scalar a)

class (PseudoRing (Scalar v), Additive v) => PseudoModule v where
   scale :: T (Scalar v) -> T v -> LLVM.CodeGenFunction r (T v)

instance PseudoModule Float where
   scale :: forall r.
T (Scalar Float) -> T Float -> CodeGenFunction r (T Float)
scale = (Repr Float -> Repr Float -> CodeGenFunction r (Repr Float))
-> T Float -> T Float -> CodeGenFunction r (T Float)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Float -> Value Float -> CodeGenFunction r (Value Float)
Repr Float -> Repr Float -> CodeGenFunction r (Repr Float)
forall r.
Value Float -> Value Float -> CodeGenFunction r (Value Float)
forall a r. PseudoRing a => a -> a -> CodeGenFunction r a
A.mul

instance PseudoModule Double where
   scale :: forall r.
T (Scalar Double) -> T Double -> CodeGenFunction r (T Double)
scale = (Repr Double -> Repr Double -> CodeGenFunction r (Repr Double))
-> T Double -> T Double -> CodeGenFunction r (T Double)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Double -> Value Double -> CodeGenFunction r (Value Double)
Repr Double -> Repr Double -> CodeGenFunction r (Repr Double)
forall r.
Value Double -> Value Double -> CodeGenFunction r (Value Double)
forall a r. PseudoRing a => a -> a -> CodeGenFunction r a
A.mul

instance (PseudoModule a) => PseudoModule (Tagged tag a) where
   scale :: forall r.
T (Scalar (Tagged tag a))
-> T (Tagged tag a) -> CodeGenFunction r (T (Tagged tag a))
scale = (T (Scalar a) -> T a -> CodeGenFunction r (T a))
-> T (Tagged tag (Scalar a))
-> T (Tagged tag a)
-> CodeGenFunction r (T (Tagged tag a))
forall (m :: * -> *) a b c tag.
Monad m =>
(T a -> T b -> m (T c))
-> T (Tagged tag a) -> T (Tagged tag b) -> m (T (Tagged tag c))
liftTaggedM2 T (Scalar a) -> T a -> CodeGenFunction r (T a)
forall v r.
PseudoModule v =>
T (Scalar v) -> T v -> CodeGenFunction r (T v)
forall r. T (Scalar a) -> T a -> CodeGenFunction r (T a)
scale

instance (PseudoModule a) => A.PseudoModule (T a) where
   scale :: forall r. Scalar (T a) -> T a -> CodeGenFunction r (T a)
scale = Scalar (T a) -> T a -> CodeGenFunction r (T a)
T (Scalar a) -> T a -> CodeGenFunction r (T a)
forall v r.
PseudoModule v =>
T (Scalar v) -> T v -> CodeGenFunction r (T v)
forall r. T (Scalar a) -> T a -> CodeGenFunction r (T a)
scale


class (Additive a) => Real a where
   min :: T a -> T a -> LLVM.CodeGenFunction r (T a)
   max :: T a -> T a -> LLVM.CodeGenFunction r (T a)
   abs :: T a -> LLVM.CodeGenFunction r (T a)
   signum :: T a -> LLVM.CodeGenFunction r (T a)

instance Real Float where
   min :: forall r. T Float -> T Float -> CodeGenFunction r (T Float)
min = (Repr Float -> Repr Float -> CodeGenFunction r (Repr Float))
-> T Float -> T Float -> CodeGenFunction r (T Float)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Float -> Value Float -> CodeGenFunction r (Value Float)
Repr Float -> Repr Float -> CodeGenFunction r (Repr Float)
forall r.
Value Float -> Value Float -> CodeGenFunction r (Value Float)
forall a r. Real a => a -> a -> CodeGenFunction r a
A.min
   max :: forall r. T Float -> T Float -> CodeGenFunction r (T Float)
max = (Repr Float -> Repr Float -> CodeGenFunction r (Repr Float))
-> T Float -> T Float -> CodeGenFunction r (T Float)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Float -> Value Float -> CodeGenFunction r (Value Float)
Repr Float -> Repr Float -> CodeGenFunction r (Repr Float)
forall r.
Value Float -> Value Float -> CodeGenFunction r (Value Float)
forall a r. Real a => a -> a -> CodeGenFunction r a
A.max
   abs :: forall r. T Float -> CodeGenFunction r (T Float)
abs = (Repr Float -> CodeGenFunction r (Repr Float))
-> T Float -> CodeGenFunction r (T Float)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Float -> CodeGenFunction r (Value Float)
Repr Float -> CodeGenFunction r (Repr Float)
forall r. Value Float -> CodeGenFunction r (Value Float)
forall a r. Real a => a -> CodeGenFunction r a
A.abs
   signum :: forall r. T Float -> CodeGenFunction r (T Float)
signum = (Repr Float -> CodeGenFunction r (Repr Float))
-> T Float -> CodeGenFunction r (T Float)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Float -> CodeGenFunction r (Value Float)
Repr Float -> CodeGenFunction r (Repr Float)
forall r. Value Float -> CodeGenFunction r (Value Float)
forall a r. Real a => a -> CodeGenFunction r a
A.signum

instance Real Double where
   min :: forall r. T Double -> T Double -> CodeGenFunction r (T Double)
min = (Repr Double -> Repr Double -> CodeGenFunction r (Repr Double))
-> T Double -> T Double -> CodeGenFunction r (T Double)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Double -> Value Double -> CodeGenFunction r (Value Double)
Repr Double -> Repr Double -> CodeGenFunction r (Repr Double)
forall r.
Value Double -> Value Double -> CodeGenFunction r (Value Double)
forall a r. Real a => a -> a -> CodeGenFunction r a
A.min
   max :: forall r. T Double -> T Double -> CodeGenFunction r (T Double)
max = (Repr Double -> Repr Double -> CodeGenFunction r (Repr Double))
-> T Double -> T Double -> CodeGenFunction r (T Double)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Double -> Value Double -> CodeGenFunction r (Value Double)
Repr Double -> Repr Double -> CodeGenFunction r (Repr Double)
forall r.
Value Double -> Value Double -> CodeGenFunction r (Value Double)
forall a r. Real a => a -> a -> CodeGenFunction r a
A.max
   abs :: forall r. T Double -> CodeGenFunction r (T Double)
abs = (Repr Double -> CodeGenFunction r (Repr Double))
-> T Double -> CodeGenFunction r (T Double)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Double -> CodeGenFunction r (Value Double)
Repr Double -> CodeGenFunction r (Repr Double)
forall r. Value Double -> CodeGenFunction r (Value Double)
forall a r. Real a => a -> CodeGenFunction r a
A.abs
   signum :: forall r. T Double -> CodeGenFunction r (T Double)
signum = (Repr Double -> CodeGenFunction r (Repr Double))
-> T Double -> CodeGenFunction r (T Double)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Double -> CodeGenFunction r (Value Double)
Repr Double -> CodeGenFunction r (Repr Double)
forall r. Value Double -> CodeGenFunction r (Value Double)
forall a r. Real a => a -> CodeGenFunction r a
A.signum

instance Real Word where
   min :: forall r. T Word -> T Word -> CodeGenFunction r (T Word)
min = (Repr Word -> Repr Word -> CodeGenFunction r (Repr Word))
-> T Word -> T Word -> CodeGenFunction r (T Word)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word -> Value Word -> CodeGenFunction r (Value Word)
Repr Word -> Repr Word -> CodeGenFunction r (Repr Word)
forall r.
Value Word -> Value Word -> CodeGenFunction r (Value Word)
forall a r. Real a => a -> a -> CodeGenFunction r a
A.min
   max :: forall r. T Word -> T Word -> CodeGenFunction r (T Word)
max = (Repr Word -> Repr Word -> CodeGenFunction r (Repr Word))
-> T Word -> T Word -> CodeGenFunction r (T Word)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word -> Value Word -> CodeGenFunction r (Value Word)
Repr Word -> Repr Word -> CodeGenFunction r (Repr Word)
forall r.
Value Word -> Value Word -> CodeGenFunction r (Value Word)
forall a r. Real a => a -> a -> CodeGenFunction r a
A.max
   abs :: forall r. T Word -> CodeGenFunction r (T Word)
abs = (Repr Word -> CodeGenFunction r (Repr Word))
-> T Word -> CodeGenFunction r (T Word)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Word -> CodeGenFunction r (Value Word)
Repr Word -> CodeGenFunction r (Repr Word)
forall r. Value Word -> CodeGenFunction r (Value Word)
forall a r. Real a => a -> CodeGenFunction r a
A.abs
   signum :: forall r. T Word -> CodeGenFunction r (T Word)
signum = (Repr Word -> CodeGenFunction r (Repr Word))
-> T Word -> CodeGenFunction r (T Word)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Word -> CodeGenFunction r (Value Word)
Repr Word -> CodeGenFunction r (Repr Word)
forall r. Value Word -> CodeGenFunction r (Value Word)
forall a r. Real a => a -> CodeGenFunction r a
A.signum

instance Real Word8 where
   min :: forall r. T Word8 -> T Word8 -> CodeGenFunction r (T Word8)
min = (Repr Word8 -> Repr Word8 -> CodeGenFunction r (Repr Word8))
-> T Word8 -> T Word8 -> CodeGenFunction r (T Word8)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word8 -> Value Word8 -> CodeGenFunction r (Value Word8)
Repr Word8 -> Repr Word8 -> CodeGenFunction r (Repr Word8)
forall r.
Value Word8 -> Value Word8 -> CodeGenFunction r (Value Word8)
forall a r. Real a => a -> a -> CodeGenFunction r a
A.min
   max :: forall r. T Word8 -> T Word8 -> CodeGenFunction r (T Word8)
max = (Repr Word8 -> Repr Word8 -> CodeGenFunction r (Repr Word8))
-> T Word8 -> T Word8 -> CodeGenFunction r (T Word8)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word8 -> Value Word8 -> CodeGenFunction r (Value Word8)
Repr Word8 -> Repr Word8 -> CodeGenFunction r (Repr Word8)
forall r.
Value Word8 -> Value Word8 -> CodeGenFunction r (Value Word8)
forall a r. Real a => a -> a -> CodeGenFunction r a
A.max
   abs :: forall r. T Word8 -> CodeGenFunction r (T Word8)
abs = (Repr Word8 -> CodeGenFunction r (Repr Word8))
-> T Word8 -> CodeGenFunction r (T Word8)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Word8 -> CodeGenFunction r (Value Word8)
Repr Word8 -> CodeGenFunction r (Repr Word8)
forall r. Value Word8 -> CodeGenFunction r (Value Word8)
forall a r. Real a => a -> CodeGenFunction r a
A.abs
   signum :: forall r. T Word8 -> CodeGenFunction r (T Word8)
signum = (Repr Word8 -> CodeGenFunction r (Repr Word8))
-> T Word8 -> CodeGenFunction r (T Word8)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Word8 -> CodeGenFunction r (Value Word8)
Repr Word8 -> CodeGenFunction r (Repr Word8)
forall r. Value Word8 -> CodeGenFunction r (Value Word8)
forall a r. Real a => a -> CodeGenFunction r a
A.signum

instance Real Word16 where
   min :: forall r. T Word16 -> T Word16 -> CodeGenFunction r (T Word16)
min = (Repr Word16 -> Repr Word16 -> CodeGenFunction r (Repr Word16))
-> T Word16 -> T Word16 -> CodeGenFunction r (T Word16)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word16 -> Value Word16 -> CodeGenFunction r (Value Word16)
Repr Word16 -> Repr Word16 -> CodeGenFunction r (Repr Word16)
forall r.
Value Word16 -> Value Word16 -> CodeGenFunction r (Value Word16)
forall a r. Real a => a -> a -> CodeGenFunction r a
A.min
   max :: forall r. T Word16 -> T Word16 -> CodeGenFunction r (T Word16)
max = (Repr Word16 -> Repr Word16 -> CodeGenFunction r (Repr Word16))
-> T Word16 -> T Word16 -> CodeGenFunction r (T Word16)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word16 -> Value Word16 -> CodeGenFunction r (Value Word16)
Repr Word16 -> Repr Word16 -> CodeGenFunction r (Repr Word16)
forall r.
Value Word16 -> Value Word16 -> CodeGenFunction r (Value Word16)
forall a r. Real a => a -> a -> CodeGenFunction r a
A.max
   abs :: forall r. T Word16 -> CodeGenFunction r (T Word16)
abs = (Repr Word16 -> CodeGenFunction r (Repr Word16))
-> T Word16 -> CodeGenFunction r (T Word16)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Word16 -> CodeGenFunction r (Value Word16)
Repr Word16 -> CodeGenFunction r (Repr Word16)
forall r. Value Word16 -> CodeGenFunction r (Value Word16)
forall a r. Real a => a -> CodeGenFunction r a
A.abs
   signum :: forall r. T Word16 -> CodeGenFunction r (T Word16)
signum = (Repr Word16 -> CodeGenFunction r (Repr Word16))
-> T Word16 -> CodeGenFunction r (T Word16)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Word16 -> CodeGenFunction r (Value Word16)
Repr Word16 -> CodeGenFunction r (Repr Word16)
forall r. Value Word16 -> CodeGenFunction r (Value Word16)
forall a r. Real a => a -> CodeGenFunction r a
A.signum

instance Real Word32 where
   min :: forall r. T Word32 -> T Word32 -> CodeGenFunction r (T Word32)
min = (Repr Word32 -> Repr Word32 -> CodeGenFunction r (Repr Word32))
-> T Word32 -> T Word32 -> CodeGenFunction r (T Word32)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word32 -> Value Word32 -> CodeGenFunction r (Value Word32)
Repr Word32 -> Repr Word32 -> CodeGenFunction r (Repr Word32)
forall r.
Value Word32 -> Value Word32 -> CodeGenFunction r (Value Word32)
forall a r. Real a => a -> a -> CodeGenFunction r a
A.min
   max :: forall r. T Word32 -> T Word32 -> CodeGenFunction r (T Word32)
max = (Repr Word32 -> Repr Word32 -> CodeGenFunction r (Repr Word32))
-> T Word32 -> T Word32 -> CodeGenFunction r (T Word32)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word32 -> Value Word32 -> CodeGenFunction r (Value Word32)
Repr Word32 -> Repr Word32 -> CodeGenFunction r (Repr Word32)
forall r.
Value Word32 -> Value Word32 -> CodeGenFunction r (Value Word32)
forall a r. Real a => a -> a -> CodeGenFunction r a
A.max
   abs :: forall r. T Word32 -> CodeGenFunction r (T Word32)
abs = (Repr Word32 -> CodeGenFunction r (Repr Word32))
-> T Word32 -> CodeGenFunction r (T Word32)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Word32 -> CodeGenFunction r (Value Word32)
Repr Word32 -> CodeGenFunction r (Repr Word32)
forall r. Value Word32 -> CodeGenFunction r (Value Word32)
forall a r. Real a => a -> CodeGenFunction r a
A.abs
   signum :: forall r. T Word32 -> CodeGenFunction r (T Word32)
signum = (Repr Word32 -> CodeGenFunction r (Repr Word32))
-> T Word32 -> CodeGenFunction r (T Word32)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Word32 -> CodeGenFunction r (Value Word32)
Repr Word32 -> CodeGenFunction r (Repr Word32)
forall r. Value Word32 -> CodeGenFunction r (Value Word32)
forall a r. Real a => a -> CodeGenFunction r a
A.signum

instance Real Word64 where
   min :: forall r. T Word64 -> T Word64 -> CodeGenFunction r (T Word64)
min = (Repr Word64 -> Repr Word64 -> CodeGenFunction r (Repr Word64))
-> T Word64 -> T Word64 -> CodeGenFunction r (T Word64)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word64 -> Value Word64 -> CodeGenFunction r (Value Word64)
Repr Word64 -> Repr Word64 -> CodeGenFunction r (Repr Word64)
forall r.
Value Word64 -> Value Word64 -> CodeGenFunction r (Value Word64)
forall a r. Real a => a -> a -> CodeGenFunction r a
A.min
   max :: forall r. T Word64 -> T Word64 -> CodeGenFunction r (T Word64)
max = (Repr Word64 -> Repr Word64 -> CodeGenFunction r (Repr Word64))
-> T Word64 -> T Word64 -> CodeGenFunction r (T Word64)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word64 -> Value Word64 -> CodeGenFunction r (Value Word64)
Repr Word64 -> Repr Word64 -> CodeGenFunction r (Repr Word64)
forall r.
Value Word64 -> Value Word64 -> CodeGenFunction r (Value Word64)
forall a r. Real a => a -> a -> CodeGenFunction r a
A.max
   abs :: forall r. T Word64 -> CodeGenFunction r (T Word64)
abs = (Repr Word64 -> CodeGenFunction r (Repr Word64))
-> T Word64 -> CodeGenFunction r (T Word64)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Word64 -> CodeGenFunction r (Value Word64)
Repr Word64 -> CodeGenFunction r (Repr Word64)
forall r. Value Word64 -> CodeGenFunction r (Value Word64)
forall a r. Real a => a -> CodeGenFunction r a
A.abs
   signum :: forall r. T Word64 -> CodeGenFunction r (T Word64)
signum = (Repr Word64 -> CodeGenFunction r (Repr Word64))
-> T Word64 -> CodeGenFunction r (T Word64)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Word64 -> CodeGenFunction r (Value Word64)
Repr Word64 -> CodeGenFunction r (Repr Word64)
forall r. Value Word64 -> CodeGenFunction r (Value Word64)
forall a r. Real a => a -> CodeGenFunction r a
A.signum

instance Real Int where
   min :: forall r. T Int -> T Int -> CodeGenFunction r (T Int)
min = (Repr Int -> Repr Int -> CodeGenFunction r (Repr Int))
-> T Int -> T Int -> CodeGenFunction r (T Int)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int -> Value Int -> CodeGenFunction r (Value Int)
Repr Int -> Repr Int -> CodeGenFunction r (Repr Int)
forall r. Value Int -> Value Int -> CodeGenFunction r (Value Int)
forall a r. Real a => a -> a -> CodeGenFunction r a
A.min
   max :: forall r. T Int -> T Int -> CodeGenFunction r (T Int)
max = (Repr Int -> Repr Int -> CodeGenFunction r (Repr Int))
-> T Int -> T Int -> CodeGenFunction r (T Int)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int -> Value Int -> CodeGenFunction r (Value Int)
Repr Int -> Repr Int -> CodeGenFunction r (Repr Int)
forall r. Value Int -> Value Int -> CodeGenFunction r (Value Int)
forall a r. Real a => a -> a -> CodeGenFunction r a
A.max
   abs :: forall r. T Int -> CodeGenFunction r (T Int)
abs = (Repr Int -> CodeGenFunction r (Repr Int))
-> T Int -> CodeGenFunction r (T Int)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Int -> CodeGenFunction r (Value Int)
Repr Int -> CodeGenFunction r (Repr Int)
forall r. Value Int -> CodeGenFunction r (Value Int)
forall a r. Real a => a -> CodeGenFunction r a
A.abs
   signum :: forall r. T Int -> CodeGenFunction r (T Int)
signum = (Repr Int -> CodeGenFunction r (Repr Int))
-> T Int -> CodeGenFunction r (T Int)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Int -> CodeGenFunction r (Value Int)
Repr Int -> CodeGenFunction r (Repr Int)
forall r. Value Int -> CodeGenFunction r (Value Int)
forall a r. Real a => a -> CodeGenFunction r a
A.signum

instance Real Int8 where
   min :: forall r. T Int8 -> T Int8 -> CodeGenFunction r (T Int8)
min = (Repr Int8 -> Repr Int8 -> CodeGenFunction r (Repr Int8))
-> T Int8 -> T Int8 -> CodeGenFunction r (T Int8)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int8 -> Value Int8 -> CodeGenFunction r (Value Int8)
Repr Int8 -> Repr Int8 -> CodeGenFunction r (Repr Int8)
forall r.
Value Int8 -> Value Int8 -> CodeGenFunction r (Value Int8)
forall a r. Real a => a -> a -> CodeGenFunction r a
A.min
   max :: forall r. T Int8 -> T Int8 -> CodeGenFunction r (T Int8)
max = (Repr Int8 -> Repr Int8 -> CodeGenFunction r (Repr Int8))
-> T Int8 -> T Int8 -> CodeGenFunction r (T Int8)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int8 -> Value Int8 -> CodeGenFunction r (Value Int8)
Repr Int8 -> Repr Int8 -> CodeGenFunction r (Repr Int8)
forall r.
Value Int8 -> Value Int8 -> CodeGenFunction r (Value Int8)
forall a r. Real a => a -> a -> CodeGenFunction r a
A.max
   abs :: forall r. T Int8 -> CodeGenFunction r (T Int8)
abs = (Repr Int8 -> CodeGenFunction r (Repr Int8))
-> T Int8 -> CodeGenFunction r (T Int8)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Int8 -> CodeGenFunction r (Value Int8)
Repr Int8 -> CodeGenFunction r (Repr Int8)
forall r. Value Int8 -> CodeGenFunction r (Value Int8)
forall a r. Real a => a -> CodeGenFunction r a
A.abs
   signum :: forall r. T Int8 -> CodeGenFunction r (T Int8)
signum = (Repr Int8 -> CodeGenFunction r (Repr Int8))
-> T Int8 -> CodeGenFunction r (T Int8)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Int8 -> CodeGenFunction r (Value Int8)
Repr Int8 -> CodeGenFunction r (Repr Int8)
forall r. Value Int8 -> CodeGenFunction r (Value Int8)
forall a r. Real a => a -> CodeGenFunction r a
A.signum

instance Real Int16 where
   min :: forall r. T Int16 -> T Int16 -> CodeGenFunction r (T Int16)
min = (Repr Int16 -> Repr Int16 -> CodeGenFunction r (Repr Int16))
-> T Int16 -> T Int16 -> CodeGenFunction r (T Int16)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int16 -> Value Int16 -> CodeGenFunction r (Value Int16)
Repr Int16 -> Repr Int16 -> CodeGenFunction r (Repr Int16)
forall r.
Value Int16 -> Value Int16 -> CodeGenFunction r (Value Int16)
forall a r. Real a => a -> a -> CodeGenFunction r a
A.min
   max :: forall r. T Int16 -> T Int16 -> CodeGenFunction r (T Int16)
max = (Repr Int16 -> Repr Int16 -> CodeGenFunction r (Repr Int16))
-> T Int16 -> T Int16 -> CodeGenFunction r (T Int16)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int16 -> Value Int16 -> CodeGenFunction r (Value Int16)
Repr Int16 -> Repr Int16 -> CodeGenFunction r (Repr Int16)
forall r.
Value Int16 -> Value Int16 -> CodeGenFunction r (Value Int16)
forall a r. Real a => a -> a -> CodeGenFunction r a
A.max
   abs :: forall r. T Int16 -> CodeGenFunction r (T Int16)
abs = (Repr Int16 -> CodeGenFunction r (Repr Int16))
-> T Int16 -> CodeGenFunction r (T Int16)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Int16 -> CodeGenFunction r (Value Int16)
Repr Int16 -> CodeGenFunction r (Repr Int16)
forall r. Value Int16 -> CodeGenFunction r (Value Int16)
forall a r. Real a => a -> CodeGenFunction r a
A.abs
   signum :: forall r. T Int16 -> CodeGenFunction r (T Int16)
signum = (Repr Int16 -> CodeGenFunction r (Repr Int16))
-> T Int16 -> CodeGenFunction r (T Int16)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Int16 -> CodeGenFunction r (Value Int16)
Repr Int16 -> CodeGenFunction r (Repr Int16)
forall r. Value Int16 -> CodeGenFunction r (Value Int16)
forall a r. Real a => a -> CodeGenFunction r a
A.signum

instance Real Int32 where
   min :: forall r. T Int32 -> T Int32 -> CodeGenFunction r (T Int32)
min = (Repr Int32 -> Repr Int32 -> CodeGenFunction r (Repr Int32))
-> T Int32 -> T Int32 -> CodeGenFunction r (T Int32)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int32 -> Value Int32 -> CodeGenFunction r (Value Int32)
Repr Int32 -> Repr Int32 -> CodeGenFunction r (Repr Int32)
forall r.
Value Int32 -> Value Int32 -> CodeGenFunction r (Value Int32)
forall a r. Real a => a -> a -> CodeGenFunction r a
A.min
   max :: forall r. T Int32 -> T Int32 -> CodeGenFunction r (T Int32)
max = (Repr Int32 -> Repr Int32 -> CodeGenFunction r (Repr Int32))
-> T Int32 -> T Int32 -> CodeGenFunction r (T Int32)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int32 -> Value Int32 -> CodeGenFunction r (Value Int32)
Repr Int32 -> Repr Int32 -> CodeGenFunction r (Repr Int32)
forall r.
Value Int32 -> Value Int32 -> CodeGenFunction r (Value Int32)
forall a r. Real a => a -> a -> CodeGenFunction r a
A.max
   abs :: forall r. T Int32 -> CodeGenFunction r (T Int32)
abs = (Repr Int32 -> CodeGenFunction r (Repr Int32))
-> T Int32 -> CodeGenFunction r (T Int32)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Int32 -> CodeGenFunction r (Value Int32)
Repr Int32 -> CodeGenFunction r (Repr Int32)
forall r. Value Int32 -> CodeGenFunction r (Value Int32)
forall a r. Real a => a -> CodeGenFunction r a
A.abs
   signum :: forall r. T Int32 -> CodeGenFunction r (T Int32)
signum = (Repr Int32 -> CodeGenFunction r (Repr Int32))
-> T Int32 -> CodeGenFunction r (T Int32)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Int32 -> CodeGenFunction r (Value Int32)
Repr Int32 -> CodeGenFunction r (Repr Int32)
forall r. Value Int32 -> CodeGenFunction r (Value Int32)
forall a r. Real a => a -> CodeGenFunction r a
A.signum

instance Real Int64 where
   min :: forall r. T Int64 -> T Int64 -> CodeGenFunction r (T Int64)
min = (Repr Int64 -> Repr Int64 -> CodeGenFunction r (Repr Int64))
-> T Int64 -> T Int64 -> CodeGenFunction r (T Int64)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int64 -> Value Int64 -> CodeGenFunction r (Value Int64)
Repr Int64 -> Repr Int64 -> CodeGenFunction r (Repr Int64)
forall r.
Value Int64 -> Value Int64 -> CodeGenFunction r (Value Int64)
forall a r. Real a => a -> a -> CodeGenFunction r a
A.min
   max :: forall r. T Int64 -> T Int64 -> CodeGenFunction r (T Int64)
max = (Repr Int64 -> Repr Int64 -> CodeGenFunction r (Repr Int64))
-> T Int64 -> T Int64 -> CodeGenFunction r (T Int64)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int64 -> Value Int64 -> CodeGenFunction r (Value Int64)
Repr Int64 -> Repr Int64 -> CodeGenFunction r (Repr Int64)
forall r.
Value Int64 -> Value Int64 -> CodeGenFunction r (Value Int64)
forall a r. Real a => a -> a -> CodeGenFunction r a
A.max
   abs :: forall r. T Int64 -> CodeGenFunction r (T Int64)
abs = (Repr Int64 -> CodeGenFunction r (Repr Int64))
-> T Int64 -> CodeGenFunction r (T Int64)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Int64 -> CodeGenFunction r (Value Int64)
Repr Int64 -> CodeGenFunction r (Repr Int64)
forall r. Value Int64 -> CodeGenFunction r (Value Int64)
forall a r. Real a => a -> CodeGenFunction r a
A.abs
   signum :: forall r. T Int64 -> CodeGenFunction r (T Int64)
signum = (Repr Int64 -> CodeGenFunction r (Repr Int64))
-> T Int64 -> CodeGenFunction r (T Int64)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Int64 -> CodeGenFunction r (Value Int64)
Repr Int64 -> CodeGenFunction r (Repr Int64)
forall r. Value Int64 -> CodeGenFunction r (Value Int64)
forall a r. Real a => a -> CodeGenFunction r a
A.signum

instance (Dec.Positive n) => Real (WordN n) where
   min :: forall r.
T (WordN n) -> T (WordN n) -> CodeGenFunction r (T (WordN n))
min = (Repr (WordN n)
 -> Repr (WordN n) -> CodeGenFunction r (Repr (WordN n)))
-> T (WordN n) -> T (WordN n) -> CodeGenFunction r (T (WordN n))
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value (WordN n)
-> Value (WordN n) -> CodeGenFunction r (Value (WordN n))
Repr (WordN n)
-> Repr (WordN n) -> CodeGenFunction r (Repr (WordN n))
forall r.
Value (WordN n)
-> Value (WordN n) -> CodeGenFunction r (Value (WordN n))
forall a r. Real a => a -> a -> CodeGenFunction r a
A.min
   max :: forall r.
T (WordN n) -> T (WordN n) -> CodeGenFunction r (T (WordN n))
max = (Repr (WordN n)
 -> Repr (WordN n) -> CodeGenFunction r (Repr (WordN n)))
-> T (WordN n) -> T (WordN n) -> CodeGenFunction r (T (WordN n))
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value (WordN n)
-> Value (WordN n) -> CodeGenFunction r (Value (WordN n))
Repr (WordN n)
-> Repr (WordN n) -> CodeGenFunction r (Repr (WordN n))
forall r.
Value (WordN n)
-> Value (WordN n) -> CodeGenFunction r (Value (WordN n))
forall a r. Real a => a -> a -> CodeGenFunction r a
A.max
   abs :: forall r. T (WordN n) -> CodeGenFunction r (T (WordN n))
abs = (Repr (WordN n) -> CodeGenFunction r (Repr (WordN n)))
-> T (WordN n) -> CodeGenFunction r (T (WordN n))
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value (WordN n) -> CodeGenFunction r (Value (WordN n))
Repr (WordN n) -> CodeGenFunction r (Repr (WordN n))
forall r. Value (WordN n) -> CodeGenFunction r (Value (WordN n))
forall a r. Real a => a -> CodeGenFunction r a
A.abs
   signum :: forall r. T (WordN n) -> CodeGenFunction r (T (WordN n))
signum = (Repr (WordN n) -> CodeGenFunction r (Repr (WordN n)))
-> T (WordN n) -> CodeGenFunction r (T (WordN n))
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value (WordN n) -> CodeGenFunction r (Value (WordN n))
Repr (WordN n) -> CodeGenFunction r (Repr (WordN n))
forall r. Value (WordN n) -> CodeGenFunction r (Value (WordN n))
forall a r. Real a => a -> CodeGenFunction r a
A.signum

instance (Dec.Positive n) => Real (IntN n) where
   min :: forall r.
T (IntN n) -> T (IntN n) -> CodeGenFunction r (T (IntN n))
min = (Repr (IntN n)
 -> Repr (IntN n) -> CodeGenFunction r (Repr (IntN n)))
-> T (IntN n) -> T (IntN n) -> CodeGenFunction r (T (IntN n))
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value (IntN n)
-> Value (IntN n) -> CodeGenFunction r (Value (IntN n))
Repr (IntN n) -> Repr (IntN n) -> CodeGenFunction r (Repr (IntN n))
forall r.
Value (IntN n)
-> Value (IntN n) -> CodeGenFunction r (Value (IntN n))
forall a r. Real a => a -> a -> CodeGenFunction r a
A.min
   max :: forall r.
T (IntN n) -> T (IntN n) -> CodeGenFunction r (T (IntN n))
max = (Repr (IntN n)
 -> Repr (IntN n) -> CodeGenFunction r (Repr (IntN n)))
-> T (IntN n) -> T (IntN n) -> CodeGenFunction r (T (IntN n))
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value (IntN n)
-> Value (IntN n) -> CodeGenFunction r (Value (IntN n))
Repr (IntN n) -> Repr (IntN n) -> CodeGenFunction r (Repr (IntN n))
forall r.
Value (IntN n)
-> Value (IntN n) -> CodeGenFunction r (Value (IntN n))
forall a r. Real a => a -> a -> CodeGenFunction r a
A.max
   abs :: forall r. T (IntN n) -> CodeGenFunction r (T (IntN n))
abs = (Repr (IntN n) -> CodeGenFunction r (Repr (IntN n)))
-> T (IntN n) -> CodeGenFunction r (T (IntN n))
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value (IntN n) -> CodeGenFunction r (Value (IntN n))
Repr (IntN n) -> CodeGenFunction r (Repr (IntN n))
forall r. Value (IntN n) -> CodeGenFunction r (Value (IntN n))
forall a r. Real a => a -> CodeGenFunction r a
A.abs
   signum :: forall r. T (IntN n) -> CodeGenFunction r (T (IntN n))
signum = (Repr (IntN n) -> CodeGenFunction r (Repr (IntN n)))
-> T (IntN n) -> CodeGenFunction r (T (IntN n))
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value (IntN n) -> CodeGenFunction r (Value (IntN n))
Repr (IntN n) -> CodeGenFunction r (Repr (IntN n))
forall r. Value (IntN n) -> CodeGenFunction r (Value (IntN n))
forall a r. Real a => a -> CodeGenFunction r a
A.signum

instance (Real a) => Real (Tagged tag a) where
   min :: forall r.
T (Tagged tag a)
-> T (Tagged tag a) -> CodeGenFunction r (T (Tagged tag a))
min = (T a -> T a -> CodeGenFunction r (T a))
-> T (Tagged tag a)
-> T (Tagged tag a)
-> CodeGenFunction r (T (Tagged tag a))
forall (m :: * -> *) a b c tag.
Monad m =>
(T a -> T b -> m (T c))
-> T (Tagged tag a) -> T (Tagged tag b) -> m (T (Tagged tag c))
liftTaggedM2 T a -> T a -> CodeGenFunction r (T a)
forall a r. Real a => T a -> T a -> CodeGenFunction r (T a)
forall r. T a -> T a -> CodeGenFunction r (T a)
min
   max :: forall r.
T (Tagged tag a)
-> T (Tagged tag a) -> CodeGenFunction r (T (Tagged tag a))
max = (T a -> T a -> CodeGenFunction r (T a))
-> T (Tagged tag a)
-> T (Tagged tag a)
-> CodeGenFunction r (T (Tagged tag a))
forall (m :: * -> *) a b c tag.
Monad m =>
(T a -> T b -> m (T c))
-> T (Tagged tag a) -> T (Tagged tag b) -> m (T (Tagged tag c))
liftTaggedM2 T a -> T a -> CodeGenFunction r (T a)
forall a r. Real a => T a -> T a -> CodeGenFunction r (T a)
forall r. T a -> T a -> CodeGenFunction r (T a)
max
   abs :: forall r. T (Tagged tag a) -> CodeGenFunction r (T (Tagged tag a))
abs = (T a -> CodeGenFunction r (T a))
-> T (Tagged tag a) -> CodeGenFunction r (T (Tagged tag a))
forall (m :: * -> *) a b tag.
Monad m =>
(T a -> m (T b)) -> T (Tagged tag a) -> m (T (Tagged tag b))
liftTaggedM T a -> CodeGenFunction r (T a)
forall a r. Real a => T a -> CodeGenFunction r (T a)
forall r. T a -> CodeGenFunction r (T a)
abs
   signum :: forall r. T (Tagged tag a) -> CodeGenFunction r (T (Tagged tag a))
signum = (T a -> CodeGenFunction r (T a))
-> T (Tagged tag a) -> CodeGenFunction r (T (Tagged tag a))
forall (m :: * -> *) a b tag.
Monad m =>
(T a -> m (T b)) -> T (Tagged tag a) -> m (T (Tagged tag b))
liftTaggedM T a -> CodeGenFunction r (T a)
forall a r. Real a => T a -> CodeGenFunction r (T a)
forall r. T a -> CodeGenFunction r (T a)
signum

instance (Real a) => A.Real (T a) where
   min :: forall r. T a -> T a -> CodeGenFunction r (T a)
min = T a -> T a -> CodeGenFunction r (T a)
forall a r. Real a => T a -> T a -> CodeGenFunction r (T a)
forall r. T a -> T a -> CodeGenFunction r (T a)
min
   max :: forall r. T a -> T a -> CodeGenFunction r (T a)
max = T a -> T a -> CodeGenFunction r (T a)
forall a r. Real a => T a -> T a -> CodeGenFunction r (T a)
forall r. T a -> T a -> CodeGenFunction r (T a)
max
   abs :: forall r. T a -> CodeGenFunction r (T a)
abs = T a -> CodeGenFunction r (T a)
forall a r. Real a => T a -> CodeGenFunction r (T a)
forall r. T a -> CodeGenFunction r (T a)
abs
   signum :: forall r. T a -> CodeGenFunction r (T a)
signum = T a -> CodeGenFunction r (T a)
forall a r. Real a => T a -> CodeGenFunction r (T a)
forall r. T a -> CodeGenFunction r (T a)
signum


class (Real a) => Fraction a where
   truncate :: T a -> LLVM.CodeGenFunction r (T a)
   fraction :: T a -> LLVM.CodeGenFunction r (T a)

instance Fraction Float where
   truncate :: forall r. T Float -> CodeGenFunction r (T Float)
truncate = (Repr Float -> CodeGenFunction r (Repr Float))
-> T Float -> CodeGenFunction r (T Float)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Float -> CodeGenFunction r (Value Float)
Repr Float -> CodeGenFunction r (Repr Float)
forall r. Value Float -> CodeGenFunction r (Value Float)
forall a r. Fraction a => a -> CodeGenFunction r a
A.truncate
   fraction :: forall r. T Float -> CodeGenFunction r (T Float)
fraction = (Repr Float -> CodeGenFunction r (Repr Float))
-> T Float -> CodeGenFunction r (T Float)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Float -> CodeGenFunction r (Value Float)
Repr Float -> CodeGenFunction r (Repr Float)
forall r. Value Float -> CodeGenFunction r (Value Float)
forall a r. Fraction a => a -> CodeGenFunction r a
A.fraction

instance Fraction Double where
   truncate :: forall r. T Double -> CodeGenFunction r (T Double)
truncate = (Repr Double -> CodeGenFunction r (Repr Double))
-> T Double -> CodeGenFunction r (T Double)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Double -> CodeGenFunction r (Value Double)
Repr Double -> CodeGenFunction r (Repr Double)
forall r. Value Double -> CodeGenFunction r (Value Double)
forall a r. Fraction a => a -> CodeGenFunction r a
A.truncate
   fraction :: forall r. T Double -> CodeGenFunction r (T Double)
fraction = (Repr Double -> CodeGenFunction r (Repr Double))
-> T Double -> CodeGenFunction r (T Double)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Double -> CodeGenFunction r (Value Double)
Repr Double -> CodeGenFunction r (Repr Double)
forall r. Value Double -> CodeGenFunction r (Value Double)
forall a r. Fraction a => a -> CodeGenFunction r a
A.fraction

instance (Fraction a) => Fraction (Tagged tag a) where
   truncate :: forall r. T (Tagged tag a) -> CodeGenFunction r (T (Tagged tag a))
truncate = (T a -> CodeGenFunction r (T a))
-> T (Tagged tag a) -> CodeGenFunction r (T (Tagged tag a))
forall (m :: * -> *) a b tag.
Monad m =>
(T a -> m (T b)) -> T (Tagged tag a) -> m (T (Tagged tag b))
liftTaggedM T a -> CodeGenFunction r (T a)
forall a r. Fraction a => T a -> CodeGenFunction r (T a)
forall r. T a -> CodeGenFunction r (T a)
truncate
   fraction :: forall r. T (Tagged tag a) -> CodeGenFunction r (T (Tagged tag a))
fraction = (T a -> CodeGenFunction r (T a))
-> T (Tagged tag a) -> CodeGenFunction r (T (Tagged tag a))
forall (m :: * -> *) a b tag.
Monad m =>
(T a -> m (T b)) -> T (Tagged tag a) -> m (T (Tagged tag b))
liftTaggedM T a -> CodeGenFunction r (T a)
forall a r. Fraction a => T a -> CodeGenFunction r (T a)
forall r. T a -> CodeGenFunction r (T a)
fraction

instance (Fraction a) => A.Fraction (T a) where
   truncate :: forall r. T a -> CodeGenFunction r (T a)
truncate = T a -> CodeGenFunction r (T a)
forall a r. Fraction a => T a -> CodeGenFunction r (T a)
forall r. T a -> CodeGenFunction r (T a)
truncate
   fraction :: forall r. T a -> CodeGenFunction r (T a)
fraction = T a -> CodeGenFunction r (T a)
forall a r. Fraction a => T a -> CodeGenFunction r (T a)
forall r. T a -> CodeGenFunction r (T a)
fraction


class
   (Repr i ~ LLVM.Value ir,
    LLVM.IsInteger ir, SoV.IntegerConstant ir,
    LLVM.CmpRet ir, LLVM.IsPrimitive ir) =>
      NativeInteger i ir where

instance NativeInteger Word   Word   where
instance NativeInteger Word8  Word8  where
instance NativeInteger Word16 Word16 where
instance NativeInteger Word32 Word32 where
instance NativeInteger Word64 Word64 where

instance NativeInteger Int   Int   where
instance NativeInteger Int8  Int8  where
instance NativeInteger Int16 Int16 where
instance NativeInteger Int32 Int32 where
instance NativeInteger Int64 Int64 where

instance NativeInteger a a => NativeInteger (Tagged tag a) a where


class
   (Repr a ~ LLVM.Value ar,
    LLVM.IsFloating ar, SoV.RationalConstant ar,
    LLVM.CmpRet ar, LLVM.IsPrimitive ar) =>
      NativeFloating a ar where

instance NativeFloating Float  Float where
instance NativeFloating Double Double where


truncateToInt, floorToInt, ceilingToInt, roundToIntFast ::
   (NativeInteger i ir, NativeFloating a ar) =>
   T a -> LLVM.CodeGenFunction r (T i)
truncateToInt :: forall i ir a ar r.
(NativeInteger i ir, NativeFloating a ar) =>
T a -> CodeGenFunction r (T i)
truncateToInt  = (Repr a -> CodeGenFunction r (Repr i))
-> T a -> CodeGenFunction r (T i)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value ar -> CodeGenFunction r (Value ir)
Repr a -> CodeGenFunction r (Repr i)
forall a i r.
(IsFloating a, IsInteger i, ShapeOf a ~ ShapeOf i) =>
Value a -> CodeGenFunction r (Value i)
SoV.truncateToInt
floorToInt :: forall i ir a ar r.
(NativeInteger i ir, NativeFloating a ar) =>
T a -> CodeGenFunction r (T i)
floorToInt     = (Repr a -> CodeGenFunction r (Repr i))
-> T a -> CodeGenFunction r (T i)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value ar -> CodeGenFunction r (Value ir)
Repr a -> CodeGenFunction r (Repr i)
forall a i r.
(IsFloating a, CmpRet a, IsInteger i, IntegerConstant i, CmpRet i,
 CmpResult a ~ CmpResult i, ShapeOf a ~ ShapeOf i) =>
Value a -> CodeGenFunction r (Value i)
SoV.floorToInt
ceilingToInt :: forall i ir a ar r.
(NativeInteger i ir, NativeFloating a ar) =>
T a -> CodeGenFunction r (T i)
ceilingToInt   = (Repr a -> CodeGenFunction r (Repr i))
-> T a -> CodeGenFunction r (T i)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value ar -> CodeGenFunction r (Value ir)
Repr a -> CodeGenFunction r (Repr i)
forall a i r.
(IsFloating a, CmpRet a, IsInteger i, IntegerConstant i, CmpRet i,
 CmpResult a ~ CmpResult i, ShapeOf a ~ ShapeOf i) =>
Value a -> CodeGenFunction r (Value i)
SoV.ceilingToInt
roundToIntFast :: forall i ir a ar r.
(NativeInteger i ir, NativeFloating a ar) =>
T a -> CodeGenFunction r (T i)
roundToIntFast = (Repr a -> CodeGenFunction r (Repr i))
-> T a -> CodeGenFunction r (T i)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value ar -> CodeGenFunction r (Value ir)
Repr a -> CodeGenFunction r (Repr i)
forall a i r.
(IsFloating a, RationalConstant a, CmpRet a, IsInteger i,
 IntegerConstant i, CmpRet i, CmpResult a ~ CmpResult i,
 ShapeOf a ~ ShapeOf i) =>
Value a -> CodeGenFunction r (Value i)
SoV.roundToIntFast

splitFractionToInt ::
   (NativeInteger i ir, NativeFloating a ar) =>
   T a -> LLVM.CodeGenFunction r (T (i,a))
splitFractionToInt :: forall i ir a ar r.
(NativeInteger i ir, NativeFloating a ar) =>
T a -> CodeGenFunction r (T (i, a))
splitFractionToInt = (Repr a -> CodeGenFunction r (Repr (i, a)))
-> T a -> CodeGenFunction r (T (i, a))
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value ar -> CodeGenFunction r (Value ir, Value ar)
Repr a -> CodeGenFunction r (Repr (i, a))
forall a i r.
(IsFloating a, CmpRet a, IsInteger i, IntegerConstant i, CmpRet i,
 CmpResult a ~ CmpResult i, ShapeOf a ~ ShapeOf i) =>
Value a -> CodeGenFunction r (Value i, Value a)
SoV.splitFractionToInt


class Field a => Algebraic a where
   sqrt :: T a -> LLVM.CodeGenFunction r (T a)

instance Algebraic Float where
   sqrt :: forall r. T Float -> CodeGenFunction r (T Float)
sqrt = (Repr Float -> CodeGenFunction r (Repr Float))
-> T Float -> CodeGenFunction r (T Float)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Float -> CodeGenFunction r (Value Float)
Repr Float -> CodeGenFunction r (Repr Float)
forall r. Value Float -> CodeGenFunction r (Value Float)
forall a r. Algebraic a => a -> CodeGenFunction r a
A.sqrt

instance Algebraic Double where
   sqrt :: forall r. T Double -> CodeGenFunction r (T Double)
sqrt = (Repr Double -> CodeGenFunction r (Repr Double))
-> T Double -> CodeGenFunction r (T Double)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Double -> CodeGenFunction r (Value Double)
Repr Double -> CodeGenFunction r (Repr Double)
forall r. Value Double -> CodeGenFunction r (Value Double)
forall a r. Algebraic a => a -> CodeGenFunction r a
A.sqrt

instance (Algebraic a) => Algebraic (Tagged tag a) where
   sqrt :: forall r. T (Tagged tag a) -> CodeGenFunction r (T (Tagged tag a))
sqrt = (T a -> CodeGenFunction r (T a))
-> T (Tagged tag a) -> CodeGenFunction r (T (Tagged tag a))
forall (m :: * -> *) a b tag.
Monad m =>
(T a -> m (T b)) -> T (Tagged tag a) -> m (T (Tagged tag b))
liftTaggedM T a -> CodeGenFunction r (T a)
forall a r. Algebraic a => T a -> CodeGenFunction r (T a)
forall r. T a -> CodeGenFunction r (T a)
sqrt

instance (Algebraic a) => A.Algebraic (T a) where
   sqrt :: forall r. T a -> CodeGenFunction r (T a)
sqrt = T a -> CodeGenFunction r (T a)
forall a r. Algebraic a => T a -> CodeGenFunction r (T a)
forall r. T a -> CodeGenFunction r (T a)
sqrt


class Algebraic a => Transcendental a where
   pi :: LLVM.CodeGenFunction r (T a)
   sin, cos, exp, log :: T a -> LLVM.CodeGenFunction r (T a)
   pow :: T a -> T a -> LLVM.CodeGenFunction r (T a)

instance Transcendental Float where
   pi :: forall r. CodeGenFunction r (T Float)
pi = CodeGenFunction r (Repr Float) -> CodeGenFunction r (T Float)
forall (m :: * -> *) a. Monad m => m (Repr a) -> m (T a)
liftM0 CodeGenFunction r (Value Float)
CodeGenFunction r (Repr Float)
forall r. CodeGenFunction r (Value Float)
forall a r. Transcendental a => CodeGenFunction r a
A.pi
   sin :: forall r. T Float -> CodeGenFunction r (T Float)
sin = (Repr Float -> CodeGenFunction r (Repr Float))
-> T Float -> CodeGenFunction r (T Float)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Float -> CodeGenFunction r (Value Float)
Repr Float -> CodeGenFunction r (Repr Float)
forall r. Value Float -> CodeGenFunction r (Value Float)
forall a r. Transcendental a => a -> CodeGenFunction r a
A.sin
   cos :: forall r. T Float -> CodeGenFunction r (T Float)
cos = (Repr Float -> CodeGenFunction r (Repr Float))
-> T Float -> CodeGenFunction r (T Float)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Float -> CodeGenFunction r (Value Float)
Repr Float -> CodeGenFunction r (Repr Float)
forall r. Value Float -> CodeGenFunction r (Value Float)
forall a r. Transcendental a => a -> CodeGenFunction r a
A.cos
   exp :: forall r. T Float -> CodeGenFunction r (T Float)
exp = (Repr Float -> CodeGenFunction r (Repr Float))
-> T Float -> CodeGenFunction r (T Float)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Float -> CodeGenFunction r (Value Float)
Repr Float -> CodeGenFunction r (Repr Float)
forall r. Value Float -> CodeGenFunction r (Value Float)
forall a r. Transcendental a => a -> CodeGenFunction r a
A.exp
   log :: forall r. T Float -> CodeGenFunction r (T Float)
log = (Repr Float -> CodeGenFunction r (Repr Float))
-> T Float -> CodeGenFunction r (T Float)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Float -> CodeGenFunction r (Value Float)
Repr Float -> CodeGenFunction r (Repr Float)
forall r. Value Float -> CodeGenFunction r (Value Float)
forall a r. Transcendental a => a -> CodeGenFunction r a
A.log
   pow :: forall r. T Float -> T Float -> CodeGenFunction r (T Float)
pow = (Repr Float -> Repr Float -> CodeGenFunction r (Repr Float))
-> T Float -> T Float -> CodeGenFunction r (T Float)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Float -> Value Float -> CodeGenFunction r (Value Float)
Repr Float -> Repr Float -> CodeGenFunction r (Repr Float)
forall r.
Value Float -> Value Float -> CodeGenFunction r (Value Float)
forall a r. Transcendental a => a -> a -> CodeGenFunction r a
A.pow

instance Transcendental Double where
   pi :: forall r. CodeGenFunction r (T Double)
pi = CodeGenFunction r (Repr Double) -> CodeGenFunction r (T Double)
forall (m :: * -> *) a. Monad m => m (Repr a) -> m (T a)
liftM0 CodeGenFunction r (Value Double)
CodeGenFunction r (Repr Double)
forall r. CodeGenFunction r (Value Double)
forall a r. Transcendental a => CodeGenFunction r a
A.pi
   sin :: forall r. T Double -> CodeGenFunction r (T Double)
sin = (Repr Double -> CodeGenFunction r (Repr Double))
-> T Double -> CodeGenFunction r (T Double)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Double -> CodeGenFunction r (Value Double)
Repr Double -> CodeGenFunction r (Repr Double)
forall r. Value Double -> CodeGenFunction r (Value Double)
forall a r. Transcendental a => a -> CodeGenFunction r a
A.sin
   cos :: forall r. T Double -> CodeGenFunction r (T Double)
cos = (Repr Double -> CodeGenFunction r (Repr Double))
-> T Double -> CodeGenFunction r (T Double)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Double -> CodeGenFunction r (Value Double)
Repr Double -> CodeGenFunction r (Repr Double)
forall r. Value Double -> CodeGenFunction r (Value Double)
forall a r. Transcendental a => a -> CodeGenFunction r a
A.cos
   exp :: forall r. T Double -> CodeGenFunction r (T Double)
exp = (Repr Double -> CodeGenFunction r (Repr Double))
-> T Double -> CodeGenFunction r (T Double)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Double -> CodeGenFunction r (Value Double)
Repr Double -> CodeGenFunction r (Repr Double)
forall r. Value Double -> CodeGenFunction r (Value Double)
forall a r. Transcendental a => a -> CodeGenFunction r a
A.exp
   log :: forall r. T Double -> CodeGenFunction r (T Double)
log = (Repr Double -> CodeGenFunction r (Repr Double))
-> T Double -> CodeGenFunction r (T Double)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Double -> CodeGenFunction r (Value Double)
Repr Double -> CodeGenFunction r (Repr Double)
forall r. Value Double -> CodeGenFunction r (Value Double)
forall a r. Transcendental a => a -> CodeGenFunction r a
A.log
   pow :: forall r. T Double -> T Double -> CodeGenFunction r (T Double)
pow = (Repr Double -> Repr Double -> CodeGenFunction r (Repr Double))
-> T Double -> T Double -> CodeGenFunction r (T Double)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Double -> Value Double -> CodeGenFunction r (Value Double)
Repr Double -> Repr Double -> CodeGenFunction r (Repr Double)
forall r.
Value Double -> Value Double -> CodeGenFunction r (Value Double)
forall a r. Transcendental a => a -> a -> CodeGenFunction r a
A.pow

instance (Transcendental a) => Transcendental (Tagged tag a) where
   pi :: forall r. CodeGenFunction r (T (Tagged tag a))
pi = (T a -> T (Tagged tag a))
-> CodeGenFunction r (T a) -> CodeGenFunction r (T (Tagged tag a))
forall a b. (a -> b) -> CodeGenFunction r a -> CodeGenFunction r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap T a -> T (Tagged tag a)
forall a tag. T a -> T (Tagged tag a)
tag CodeGenFunction r (T a)
forall r. CodeGenFunction r (T a)
forall a r. Transcendental a => CodeGenFunction r (T a)
pi
   sin :: forall r. T (Tagged tag a) -> CodeGenFunction r (T (Tagged tag a))
sin = (T a -> CodeGenFunction r (T a))
-> T (Tagged tag a) -> CodeGenFunction r (T (Tagged tag a))
forall (m :: * -> *) a b tag.
Monad m =>
(T a -> m (T b)) -> T (Tagged tag a) -> m (T (Tagged tag b))
liftTaggedM T a -> CodeGenFunction r (T a)
forall a r. Transcendental a => T a -> CodeGenFunction r (T a)
forall r. T a -> CodeGenFunction r (T a)
sin
   cos :: forall r. T (Tagged tag a) -> CodeGenFunction r (T (Tagged tag a))
cos = (T a -> CodeGenFunction r (T a))
-> T (Tagged tag a) -> CodeGenFunction r (T (Tagged tag a))
forall (m :: * -> *) a b tag.
Monad m =>
(T a -> m (T b)) -> T (Tagged tag a) -> m (T (Tagged tag b))
liftTaggedM T a -> CodeGenFunction r (T a)
forall a r. Transcendental a => T a -> CodeGenFunction r (T a)
forall r. T a -> CodeGenFunction r (T a)
cos
   exp :: forall r. T (Tagged tag a) -> CodeGenFunction r (T (Tagged tag a))
exp = (T a -> CodeGenFunction r (T a))
-> T (Tagged tag a) -> CodeGenFunction r (T (Tagged tag a))
forall (m :: * -> *) a b tag.
Monad m =>
(T a -> m (T b)) -> T (Tagged tag a) -> m (T (Tagged tag b))
liftTaggedM T a -> CodeGenFunction r (T a)
forall a r. Transcendental a => T a -> CodeGenFunction r (T a)
forall r. T a -> CodeGenFunction r (T a)
exp
   log :: forall r. T (Tagged tag a) -> CodeGenFunction r (T (Tagged tag a))
log = (T a -> CodeGenFunction r (T a))
-> T (Tagged tag a) -> CodeGenFunction r (T (Tagged tag a))
forall (m :: * -> *) a b tag.
Monad m =>
(T a -> m (T b)) -> T (Tagged tag a) -> m (T (Tagged tag b))
liftTaggedM T a -> CodeGenFunction r (T a)
forall a r. Transcendental a => T a -> CodeGenFunction r (T a)
forall r. T a -> CodeGenFunction r (T a)
log
   pow :: forall r.
T (Tagged tag a)
-> T (Tagged tag a) -> CodeGenFunction r (T (Tagged tag a))
pow = (T a -> T a -> CodeGenFunction r (T a))
-> T (Tagged tag a)
-> T (Tagged tag a)
-> CodeGenFunction r (T (Tagged tag a))
forall (m :: * -> *) a b c tag.
Monad m =>
(T a -> T b -> m (T c))
-> T (Tagged tag a) -> T (Tagged tag b) -> m (T (Tagged tag c))
liftTaggedM2 T a -> T a -> CodeGenFunction r (T a)
forall a r.
Transcendental a =>
T a -> T a -> CodeGenFunction r (T a)
forall r. T a -> T a -> CodeGenFunction r (T a)
pow

instance (Transcendental a) => A.Transcendental (T a) where
   pi :: forall r. CodeGenFunction r (T a)
pi = CodeGenFunction r (T a)
forall r. CodeGenFunction r (T a)
forall a r. Transcendental a => CodeGenFunction r (T a)
pi
   sin :: forall r. T a -> CodeGenFunction r (T a)
sin = T a -> CodeGenFunction r (T a)
forall a r. Transcendental a => T a -> CodeGenFunction r (T a)
forall r. T a -> CodeGenFunction r (T a)
sin
   cos :: forall r. T a -> CodeGenFunction r (T a)
cos = T a -> CodeGenFunction r (T a)
forall a r. Transcendental a => T a -> CodeGenFunction r (T a)
forall r. T a -> CodeGenFunction r (T a)
cos
   exp :: forall r. T a -> CodeGenFunction r (T a)
exp = T a -> CodeGenFunction r (T a)
forall a r. Transcendental a => T a -> CodeGenFunction r (T a)
forall r. T a -> CodeGenFunction r (T a)
exp
   log :: forall r. T a -> CodeGenFunction r (T a)
log = T a -> CodeGenFunction r (T a)
forall a r. Transcendental a => T a -> CodeGenFunction r (T a)
forall r. T a -> CodeGenFunction r (T a)
log
   pow :: forall r. T a -> T a -> CodeGenFunction r (T a)
pow = T a -> T a -> CodeGenFunction r (T a)
forall a r.
Transcendental a =>
T a -> T a -> CodeGenFunction r (T a)
forall r. T a -> T a -> CodeGenFunction r (T a)
pow



class (C a) => Select a where
   select ::
      T Bool -> T a -> T a ->
      LLVM.CodeGenFunction r (T a)

instance Select Bool where select :: forall r. T Bool -> T Bool -> T Bool -> CodeGenFunction r (T Bool)
select = (Repr Bool
 -> Repr Bool -> Repr Bool -> CodeGenFunction r (Repr Bool))
-> T Bool -> T Bool -> T Bool -> CodeGenFunction r (T Bool)
forall (m :: * -> *) a b c d.
Monad m =>
(Repr a -> Repr b -> Repr c -> m (Repr d))
-> T a -> T b -> T c -> m (T d)
liftM3 Value (CmpResult Bool)
-> Value Bool -> Value Bool -> CodeGenFunction r (Value Bool)
Repr Bool
-> Repr Bool -> Repr Bool -> CodeGenFunction r (Repr Bool)
forall a r.
CmpRet a =>
Value (CmpResult a)
-> Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.select
instance Select Bool8 where select :: forall r.
T Bool -> T Bool8 -> T Bool8 -> CodeGenFunction r (T Bool8)
select = (Repr Bool
 -> Repr Bool8 -> Repr Bool8 -> CodeGenFunction r (Repr Bool8))
-> T Bool -> T Bool8 -> T Bool8 -> CodeGenFunction r (T Bool8)
forall (m :: * -> *) a b c d.
Monad m =>
(Repr a -> Repr b -> Repr c -> m (Repr d))
-> T a -> T b -> T c -> m (T d)
liftM3 Value (CmpResult Bool)
-> Value Bool -> Value Bool -> CodeGenFunction r (Value Bool)
Repr Bool
-> Repr Bool8 -> Repr Bool8 -> CodeGenFunction r (Repr Bool8)
forall a r.
CmpRet a =>
Value (CmpResult a)
-> Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.select
instance Select Float where select :: forall r.
T Bool -> T Float -> T Float -> CodeGenFunction r (T Float)
select = (Repr Bool
 -> Repr Float -> Repr Float -> CodeGenFunction r (Repr Float))
-> T Bool -> T Float -> T Float -> CodeGenFunction r (T Float)
forall (m :: * -> *) a b c d.
Monad m =>
(Repr a -> Repr b -> Repr c -> m (Repr d))
-> T a -> T b -> T c -> m (T d)
liftM3 Value (CmpResult Float)
-> Value Float -> Value Float -> CodeGenFunction r (Value Float)
Repr Bool
-> Repr Float -> Repr Float -> CodeGenFunction r (Repr Float)
forall a r.
CmpRet a =>
Value (CmpResult a)
-> Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.select
instance Select Double where select :: forall r.
T Bool -> T Double -> T Double -> CodeGenFunction r (T Double)
select = (Repr Bool
 -> Repr Double -> Repr Double -> CodeGenFunction r (Repr Double))
-> T Bool -> T Double -> T Double -> CodeGenFunction r (T Double)
forall (m :: * -> *) a b c d.
Monad m =>
(Repr a -> Repr b -> Repr c -> m (Repr d))
-> T a -> T b -> T c -> m (T d)
liftM3 Value (CmpResult Double)
-> Value Double -> Value Double -> CodeGenFunction r (Value Double)
Repr Bool
-> Repr Double -> Repr Double -> CodeGenFunction r (Repr Double)
forall a r.
CmpRet a =>
Value (CmpResult a)
-> Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.select
instance Select Word where select :: forall r. T Bool -> T Word -> T Word -> CodeGenFunction r (T Word)
select = (Repr Bool
 -> Repr Word -> Repr Word -> CodeGenFunction r (Repr Word))
-> T Bool -> T Word -> T Word -> CodeGenFunction r (T Word)
forall (m :: * -> *) a b c d.
Monad m =>
(Repr a -> Repr b -> Repr c -> m (Repr d))
-> T a -> T b -> T c -> m (T d)
liftM3 Value (CmpResult Word)
-> Value Word -> Value Word -> CodeGenFunction r (Value Word)
Repr Bool
-> Repr Word -> Repr Word -> CodeGenFunction r (Repr Word)
forall a r.
CmpRet a =>
Value (CmpResult a)
-> Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.select
instance Select Word8 where select :: forall r.
T Bool -> T Word8 -> T Word8 -> CodeGenFunction r (T Word8)
select = (Repr Bool
 -> Repr Word8 -> Repr Word8 -> CodeGenFunction r (Repr Word8))
-> T Bool -> T Word8 -> T Word8 -> CodeGenFunction r (T Word8)
forall (m :: * -> *) a b c d.
Monad m =>
(Repr a -> Repr b -> Repr c -> m (Repr d))
-> T a -> T b -> T c -> m (T d)
liftM3 Value (CmpResult Word8)
-> Value Word8 -> Value Word8 -> CodeGenFunction r (Value Word8)
Repr Bool
-> Repr Word8 -> Repr Word8 -> CodeGenFunction r (Repr Word8)
forall a r.
CmpRet a =>
Value (CmpResult a)
-> Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.select
instance Select Word16 where select :: forall r.
T Bool -> T Word16 -> T Word16 -> CodeGenFunction r (T Word16)
select = (Repr Bool
 -> Repr Word16 -> Repr Word16 -> CodeGenFunction r (Repr Word16))
-> T Bool -> T Word16 -> T Word16 -> CodeGenFunction r (T Word16)
forall (m :: * -> *) a b c d.
Monad m =>
(Repr a -> Repr b -> Repr c -> m (Repr d))
-> T a -> T b -> T c -> m (T d)
liftM3 Value (CmpResult Word16)
-> Value Word16 -> Value Word16 -> CodeGenFunction r (Value Word16)
Repr Bool
-> Repr Word16 -> Repr Word16 -> CodeGenFunction r (Repr Word16)
forall a r.
CmpRet a =>
Value (CmpResult a)
-> Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.select
instance Select Word32 where select :: forall r.
T Bool -> T Word32 -> T Word32 -> CodeGenFunction r (T Word32)
select = (Repr Bool
 -> Repr Word32 -> Repr Word32 -> CodeGenFunction r (Repr Word32))
-> T Bool -> T Word32 -> T Word32 -> CodeGenFunction r (T Word32)
forall (m :: * -> *) a b c d.
Monad m =>
(Repr a -> Repr b -> Repr c -> m (Repr d))
-> T a -> T b -> T c -> m (T d)
liftM3 Value (CmpResult Word32)
-> Value Word32 -> Value Word32 -> CodeGenFunction r (Value Word32)
Repr Bool
-> Repr Word32 -> Repr Word32 -> CodeGenFunction r (Repr Word32)
forall a r.
CmpRet a =>
Value (CmpResult a)
-> Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.select
instance Select Word64 where select :: forall r.
T Bool -> T Word64 -> T Word64 -> CodeGenFunction r (T Word64)
select = (Repr Bool
 -> Repr Word64 -> Repr Word64 -> CodeGenFunction r (Repr Word64))
-> T Bool -> T Word64 -> T Word64 -> CodeGenFunction r (T Word64)
forall (m :: * -> *) a b c d.
Monad m =>
(Repr a -> Repr b -> Repr c -> m (Repr d))
-> T a -> T b -> T c -> m (T d)
liftM3 Value (CmpResult Word64)
-> Value Word64 -> Value Word64 -> CodeGenFunction r (Value Word64)
Repr Bool
-> Repr Word64 -> Repr Word64 -> CodeGenFunction r (Repr Word64)
forall a r.
CmpRet a =>
Value (CmpResult a)
-> Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.select
instance Select Int where select :: forall r. T Bool -> T Int -> T Int -> CodeGenFunction r (T Int)
select = (Repr Bool -> Repr Int -> Repr Int -> CodeGenFunction r (Repr Int))
-> T Bool -> T Int -> T Int -> CodeGenFunction r (T Int)
forall (m :: * -> *) a b c d.
Monad m =>
(Repr a -> Repr b -> Repr c -> m (Repr d))
-> T a -> T b -> T c -> m (T d)
liftM3 Value (CmpResult Int)
-> Value Int -> Value Int -> CodeGenFunction r (Value Int)
Repr Bool -> Repr Int -> Repr Int -> CodeGenFunction r (Repr Int)
forall a r.
CmpRet a =>
Value (CmpResult a)
-> Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.select
instance Select Int8 where select :: forall r. T Bool -> T Int8 -> T Int8 -> CodeGenFunction r (T Int8)
select = (Repr Bool
 -> Repr Int8 -> Repr Int8 -> CodeGenFunction r (Repr Int8))
-> T Bool -> T Int8 -> T Int8 -> CodeGenFunction r (T Int8)
forall (m :: * -> *) a b c d.
Monad m =>
(Repr a -> Repr b -> Repr c -> m (Repr d))
-> T a -> T b -> T c -> m (T d)
liftM3 Value (CmpResult Int8)
-> Value Int8 -> Value Int8 -> CodeGenFunction r (Value Int8)
Repr Bool
-> Repr Int8 -> Repr Int8 -> CodeGenFunction r (Repr Int8)
forall a r.
CmpRet a =>
Value (CmpResult a)
-> Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.select
instance Select Int16 where select :: forall r.
T Bool -> T Int16 -> T Int16 -> CodeGenFunction r (T Int16)
select = (Repr Bool
 -> Repr Int16 -> Repr Int16 -> CodeGenFunction r (Repr Int16))
-> T Bool -> T Int16 -> T Int16 -> CodeGenFunction r (T Int16)
forall (m :: * -> *) a b c d.
Monad m =>
(Repr a -> Repr b -> Repr c -> m (Repr d))
-> T a -> T b -> T c -> m (T d)
liftM3 Value (CmpResult Int16)
-> Value Int16 -> Value Int16 -> CodeGenFunction r (Value Int16)
Repr Bool
-> Repr Int16 -> Repr Int16 -> CodeGenFunction r (Repr Int16)
forall a r.
CmpRet a =>
Value (CmpResult a)
-> Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.select
instance Select Int32 where select :: forall r.
T Bool -> T Int32 -> T Int32 -> CodeGenFunction r (T Int32)
select = (Repr Bool
 -> Repr Int32 -> Repr Int32 -> CodeGenFunction r (Repr Int32))
-> T Bool -> T Int32 -> T Int32 -> CodeGenFunction r (T Int32)
forall (m :: * -> *) a b c d.
Monad m =>
(Repr a -> Repr b -> Repr c -> m (Repr d))
-> T a -> T b -> T c -> m (T d)
liftM3 Value (CmpResult Int32)
-> Value Int32 -> Value Int32 -> CodeGenFunction r (Value Int32)
Repr Bool
-> Repr Int32 -> Repr Int32 -> CodeGenFunction r (Repr Int32)
forall a r.
CmpRet a =>
Value (CmpResult a)
-> Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.select
instance Select Int64 where select :: forall r.
T Bool -> T Int64 -> T Int64 -> CodeGenFunction r (T Int64)
select = (Repr Bool
 -> Repr Int64 -> Repr Int64 -> CodeGenFunction r (Repr Int64))
-> T Bool -> T Int64 -> T Int64 -> CodeGenFunction r (T Int64)
forall (m :: * -> *) a b c d.
Monad m =>
(Repr a -> Repr b -> Repr c -> m (Repr d))
-> T a -> T b -> T c -> m (T d)
liftM3 Value (CmpResult Int64)
-> Value Int64 -> Value Int64 -> CodeGenFunction r (Value Int64)
Repr Bool
-> Repr Int64 -> Repr Int64 -> CodeGenFunction r (Repr Int64)
forall a r.
CmpRet a =>
Value (CmpResult a)
-> Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.select

instance (Select a, Select b) => Select (a,b) where
   select :: forall r.
T Bool -> T (a, b) -> T (a, b) -> CodeGenFunction r (T (a, b))
select T Bool
b =
      (Atom a, Atom b)
-> (Atom a, Atom b)
-> (Decomposed T (Atom a, Atom b)
    -> Decomposed T (Atom a, Atom b) -> CodeGenFunction r (T a, T b))
-> T (PatternTuple (Atom a, Atom b))
-> T (PatternTuple (Atom a, Atom b))
-> CodeGenFunction r (T (Composed (T a, T b)))
forall a patternA patternB (f :: * -> *).
(Compose a, Decompose patternA, Decompose patternB, Functor f) =>
patternA
-> patternB
-> (Decomposed T patternA -> Decomposed T patternB -> f a)
-> T (PatternTuple patternA)
-> T (PatternTuple patternB)
-> f (T (Composed a))
modifyF2 (Atom a
forall a. Atom a
atom,Atom b
forall a. Atom a
atom) (Atom a
forall a. Atom a
atom,Atom b
forall a. Atom a
atom) ((Decomposed T (Atom a, Atom b)
  -> Decomposed T (Atom a, Atom b) -> CodeGenFunction r (T a, T b))
 -> T (PatternTuple (Atom a, Atom b))
 -> T (PatternTuple (Atom a, Atom b))
 -> CodeGenFunction r (T (Composed (T a, T b))))
-> (Decomposed T (Atom a, Atom b)
    -> Decomposed T (Atom a, Atom b) -> CodeGenFunction r (T a, T b))
-> T (PatternTuple (Atom a, Atom b))
-> T (PatternTuple (Atom a, Atom b))
-> CodeGenFunction r (T (Composed (T a, T b)))
forall a b. (a -> b) -> a -> b
$
      \(T a
a0,T b
b0) (T a
a1,T b
b1) ->
         (T a -> T b -> (T a, T b))
-> CodeGenFunction r (T a)
-> CodeGenFunction r (T b)
-> CodeGenFunction r (T a, T b)
forall (m :: * -> *) a b r.
Monad m =>
(a -> b -> r) -> m a -> m b -> m r
Monad.lift2 (,)
            (T Bool -> T a -> T a -> CodeGenFunction r (T a)
forall a r.
Select a =>
T Bool -> T a -> T a -> CodeGenFunction r (T a)
forall r. T Bool -> T a -> T a -> CodeGenFunction r (T a)
select T Bool
b T a
a0 T a
a1)
            (T Bool -> T b -> T b -> CodeGenFunction r (T b)
forall a r.
Select a =>
T Bool -> T a -> T a -> CodeGenFunction r (T a)
forall r. T Bool -> T b -> T b -> CodeGenFunction r (T b)
select T Bool
b T b
b0 T b
b1)

instance (Select a, Select b, Select c) => Select (a,b,c) where
   select :: forall r.
T Bool
-> T (a, b, c) -> T (a, b, c) -> CodeGenFunction r (T (a, b, c))
select T Bool
b =
      (Atom a, Atom b, Atom c)
-> (Atom a, Atom b, Atom c)
-> (Decomposed T (Atom a, Atom b, Atom c)
    -> Decomposed T (Atom a, Atom b, Atom c)
    -> CodeGenFunction r (T a, T b, T c))
-> T (PatternTuple (Atom a, Atom b, Atom c))
-> T (PatternTuple (Atom a, Atom b, Atom c))
-> CodeGenFunction r (T (Composed (T a, T b, T c)))
forall a patternA patternB (f :: * -> *).
(Compose a, Decompose patternA, Decompose patternB, Functor f) =>
patternA
-> patternB
-> (Decomposed T patternA -> Decomposed T patternB -> f a)
-> T (PatternTuple patternA)
-> T (PatternTuple patternB)
-> f (T (Composed a))
modifyF2 (Atom a
forall a. Atom a
atom,Atom b
forall a. Atom a
atom,Atom c
forall a. Atom a
atom) (Atom a
forall a. Atom a
atom,Atom b
forall a. Atom a
atom,Atom c
forall a. Atom a
atom) ((Decomposed T (Atom a, Atom b, Atom c)
  -> Decomposed T (Atom a, Atom b, Atom c)
  -> CodeGenFunction r (T a, T b, T c))
 -> T (PatternTuple (Atom a, Atom b, Atom c))
 -> T (PatternTuple (Atom a, Atom b, Atom c))
 -> CodeGenFunction r (T (Composed (T a, T b, T c))))
-> (Decomposed T (Atom a, Atom b, Atom c)
    -> Decomposed T (Atom a, Atom b, Atom c)
    -> CodeGenFunction r (T a, T b, T c))
-> T (PatternTuple (Atom a, Atom b, Atom c))
-> T (PatternTuple (Atom a, Atom b, Atom c))
-> CodeGenFunction r (T (Composed (T a, T b, T c)))
forall a b. (a -> b) -> a -> b
$
      \(T a
a0,T b
b0,T c
c0) (T a
a1,T b
b1,T c
c1) ->
         (T a -> T b -> T c -> (T a, T b, T c))
-> CodeGenFunction r (T a)
-> CodeGenFunction r (T b)
-> CodeGenFunction r (T c)
-> CodeGenFunction r (T a, T b, T c)
forall (m :: * -> *) a b c r.
Monad m =>
(a -> b -> c -> r) -> m a -> m b -> m c -> m r
Monad.lift3 (,,)
            (T Bool -> T a -> T a -> CodeGenFunction r (T a)
forall a r.
Select a =>
T Bool -> T a -> T a -> CodeGenFunction r (T a)
forall r. T Bool -> T a -> T a -> CodeGenFunction r (T a)
select T Bool
b T a
a0 T a
a1)
            (T Bool -> T b -> T b -> CodeGenFunction r (T b)
forall a r.
Select a =>
T Bool -> T a -> T a -> CodeGenFunction r (T a)
forall r. T Bool -> T b -> T b -> CodeGenFunction r (T b)
select T Bool
b T b
b0 T b
b1)
            (T Bool -> T c -> T c -> CodeGenFunction r (T c)
forall a r.
Select a =>
T Bool -> T a -> T a -> CodeGenFunction r (T a)
forall r. T Bool -> T c -> T c -> CodeGenFunction r (T c)
select T Bool
b T c
c0 T c
c1)

instance (Select a) => Select (Tagged tag a) where
   select :: forall r.
T Bool
-> T (Tagged tag a)
-> T (Tagged tag a)
-> CodeGenFunction r (T (Tagged tag a))
select = (T a -> T a -> CodeGenFunction r (T a))
-> T (Tagged tag a)
-> T (Tagged tag a)
-> CodeGenFunction r (T (Tagged tag a))
forall (m :: * -> *) a b c tag.
Monad m =>
(T a -> T b -> m (T c))
-> T (Tagged tag a) -> T (Tagged tag b) -> m (T (Tagged tag c))
liftTaggedM2 ((T a -> T a -> CodeGenFunction r (T a))
 -> T (Tagged tag a)
 -> T (Tagged tag a)
 -> CodeGenFunction r (T (Tagged tag a)))
-> (T Bool -> T a -> T a -> CodeGenFunction r (T a))
-> T Bool
-> T (Tagged tag a)
-> T (Tagged tag a)
-> CodeGenFunction r (T (Tagged tag a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T Bool -> T a -> T a -> CodeGenFunction r (T a)
forall a r.
Select a =>
T Bool -> T a -> T a -> CodeGenFunction r (T a)
forall r. T Bool -> T a -> T a -> CodeGenFunction r (T a)
select

instance (Select a) => C.Select (T a) where
   select :: forall r. Value Bool -> T a -> T a -> CodeGenFunction r (T a)
select Value Bool
b = T Bool -> T a -> T a -> CodeGenFunction r (T a)
forall a r.
Select a =>
T Bool -> T a -> T a -> CodeGenFunction r (T a)
forall r. T Bool -> T a -> T a -> CodeGenFunction r (T a)
select (Repr Bool -> T Bool
forall a. Repr a -> T a
Cons Value Bool
Repr Bool
b)



class (Real a) => Comparison a where
   {- |
   It must hold

   > max x y  ==  do gt <- cmp CmpGT x y; select gt x y
   -}
   cmp ::
      LLVM.CmpPredicate -> T a -> T a ->
      LLVM.CodeGenFunction r (T Bool)

instance Comparison Float where cmp :: forall r.
CmpPredicate -> T Float -> T Float -> CodeGenFunction r (T Bool)
cmp = (Value Float -> Value Float -> CodeGenFunction r (Value Bool))
-> T Float -> T Float -> CodeGenFunction r (T Bool)
(Repr Float -> Repr Float -> CodeGenFunction r (Repr Bool))
-> T Float -> T Float -> CodeGenFunction r (T Bool)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 ((Value Float -> Value Float -> CodeGenFunction r (Value Bool))
 -> T Float -> T Float -> CodeGenFunction r (T Bool))
-> (CmpPredicate
    -> Value Float -> Value Float -> CodeGenFunction r (Value Bool))
-> CmpPredicate
-> T Float
-> T Float
-> CodeGenFunction r (T Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmpPredicate
-> Value Float -> Value Float -> CodeGenFunction r (Value Bool)
CmpPredicate
-> Value Float
-> Value Float
-> CodeGenFunction r (CmpValueResult Value Value Float)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, CmpRet a) =>
CmpPredicate
-> value0 a
-> value1 a
-> CodeGenFunction r (CmpValueResult value0 value1 a)
LLVM.cmp
instance Comparison Double where cmp :: forall r.
CmpPredicate -> T Double -> T Double -> CodeGenFunction r (T Bool)
cmp = (Value Double -> Value Double -> CodeGenFunction r (Value Bool))
-> T Double -> T Double -> CodeGenFunction r (T Bool)
(Repr Double -> Repr Double -> CodeGenFunction r (Repr Bool))
-> T Double -> T Double -> CodeGenFunction r (T Bool)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 ((Value Double -> Value Double -> CodeGenFunction r (Value Bool))
 -> T Double -> T Double -> CodeGenFunction r (T Bool))
-> (CmpPredicate
    -> Value Double -> Value Double -> CodeGenFunction r (Value Bool))
-> CmpPredicate
-> T Double
-> T Double
-> CodeGenFunction r (T Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmpPredicate
-> Value Double -> Value Double -> CodeGenFunction r (Value Bool)
CmpPredicate
-> Value Double
-> Value Double
-> CodeGenFunction r (CmpValueResult Value Value Double)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, CmpRet a) =>
CmpPredicate
-> value0 a
-> value1 a
-> CodeGenFunction r (CmpValueResult value0 value1 a)
LLVM.cmp

instance Comparison Int where cmp :: forall r.
CmpPredicate -> T Int -> T Int -> CodeGenFunction r (T Bool)
cmp = (Value Int -> Value Int -> CodeGenFunction r (Value Bool))
-> T Int -> T Int -> CodeGenFunction r (T Bool)
(Repr Int -> Repr Int -> CodeGenFunction r (Repr Bool))
-> T Int -> T Int -> CodeGenFunction r (T Bool)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 ((Value Int -> Value Int -> CodeGenFunction r (Value Bool))
 -> T Int -> T Int -> CodeGenFunction r (T Bool))
-> (CmpPredicate
    -> Value Int -> Value Int -> CodeGenFunction r (Value Bool))
-> CmpPredicate
-> T Int
-> T Int
-> CodeGenFunction r (T Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmpPredicate
-> Value Int -> Value Int -> CodeGenFunction r (Value Bool)
CmpPredicate
-> Value Int
-> Value Int
-> CodeGenFunction r (CmpValueResult Value Value Int)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, CmpRet a) =>
CmpPredicate
-> value0 a
-> value1 a
-> CodeGenFunction r (CmpValueResult value0 value1 a)
LLVM.cmp
instance Comparison Int8 where cmp :: forall r.
CmpPredicate -> T Int8 -> T Int8 -> CodeGenFunction r (T Bool)
cmp = (Value Int8 -> Value Int8 -> CodeGenFunction r (Value Bool))
-> T Int8 -> T Int8 -> CodeGenFunction r (T Bool)
(Repr Int8 -> Repr Int8 -> CodeGenFunction r (Repr Bool))
-> T Int8 -> T Int8 -> CodeGenFunction r (T Bool)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 ((Value Int8 -> Value Int8 -> CodeGenFunction r (Value Bool))
 -> T Int8 -> T Int8 -> CodeGenFunction r (T Bool))
-> (CmpPredicate
    -> Value Int8 -> Value Int8 -> CodeGenFunction r (Value Bool))
-> CmpPredicate
-> T Int8
-> T Int8
-> CodeGenFunction r (T Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmpPredicate
-> Value Int8 -> Value Int8 -> CodeGenFunction r (Value Bool)
CmpPredicate
-> Value Int8
-> Value Int8
-> CodeGenFunction r (CmpValueResult Value Value Int8)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, CmpRet a) =>
CmpPredicate
-> value0 a
-> value1 a
-> CodeGenFunction r (CmpValueResult value0 value1 a)
LLVM.cmp
instance Comparison Int16 where cmp :: forall r.
CmpPredicate -> T Int16 -> T Int16 -> CodeGenFunction r (T Bool)
cmp = (Value Int16 -> Value Int16 -> CodeGenFunction r (Value Bool))
-> T Int16 -> T Int16 -> CodeGenFunction r (T Bool)
(Repr Int16 -> Repr Int16 -> CodeGenFunction r (Repr Bool))
-> T Int16 -> T Int16 -> CodeGenFunction r (T Bool)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 ((Value Int16 -> Value Int16 -> CodeGenFunction r (Value Bool))
 -> T Int16 -> T Int16 -> CodeGenFunction r (T Bool))
-> (CmpPredicate
    -> Value Int16 -> Value Int16 -> CodeGenFunction r (Value Bool))
-> CmpPredicate
-> T Int16
-> T Int16
-> CodeGenFunction r (T Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmpPredicate
-> Value Int16 -> Value Int16 -> CodeGenFunction r (Value Bool)
CmpPredicate
-> Value Int16
-> Value Int16
-> CodeGenFunction r (CmpValueResult Value Value Int16)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, CmpRet a) =>
CmpPredicate
-> value0 a
-> value1 a
-> CodeGenFunction r (CmpValueResult value0 value1 a)
LLVM.cmp
instance Comparison Int32 where cmp :: forall r.
CmpPredicate -> T Int32 -> T Int32 -> CodeGenFunction r (T Bool)
cmp = (Value Int32 -> Value Int32 -> CodeGenFunction r (Value Bool))
-> T Int32 -> T Int32 -> CodeGenFunction r (T Bool)
(Repr Int32 -> Repr Int32 -> CodeGenFunction r (Repr Bool))
-> T Int32 -> T Int32 -> CodeGenFunction r (T Bool)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 ((Value Int32 -> Value Int32 -> CodeGenFunction r (Value Bool))
 -> T Int32 -> T Int32 -> CodeGenFunction r (T Bool))
-> (CmpPredicate
    -> Value Int32 -> Value Int32 -> CodeGenFunction r (Value Bool))
-> CmpPredicate
-> T Int32
-> T Int32
-> CodeGenFunction r (T Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmpPredicate
-> Value Int32 -> Value Int32 -> CodeGenFunction r (Value Bool)
CmpPredicate
-> Value Int32
-> Value Int32
-> CodeGenFunction r (CmpValueResult Value Value Int32)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, CmpRet a) =>
CmpPredicate
-> value0 a
-> value1 a
-> CodeGenFunction r (CmpValueResult value0 value1 a)
LLVM.cmp
instance Comparison Int64 where cmp :: forall r.
CmpPredicate -> T Int64 -> T Int64 -> CodeGenFunction r (T Bool)
cmp = (Value Int64 -> Value Int64 -> CodeGenFunction r (Value Bool))
-> T Int64 -> T Int64 -> CodeGenFunction r (T Bool)
(Repr Int64 -> Repr Int64 -> CodeGenFunction r (Repr Bool))
-> T Int64 -> T Int64 -> CodeGenFunction r (T Bool)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 ((Value Int64 -> Value Int64 -> CodeGenFunction r (Value Bool))
 -> T Int64 -> T Int64 -> CodeGenFunction r (T Bool))
-> (CmpPredicate
    -> Value Int64 -> Value Int64 -> CodeGenFunction r (Value Bool))
-> CmpPredicate
-> T Int64
-> T Int64
-> CodeGenFunction r (T Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmpPredicate
-> Value Int64 -> Value Int64 -> CodeGenFunction r (Value Bool)
CmpPredicate
-> Value Int64
-> Value Int64
-> CodeGenFunction r (CmpValueResult Value Value Int64)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, CmpRet a) =>
CmpPredicate
-> value0 a
-> value1 a
-> CodeGenFunction r (CmpValueResult value0 value1 a)
LLVM.cmp

instance Comparison Word where cmp :: forall r.
CmpPredicate -> T Word -> T Word -> CodeGenFunction r (T Bool)
cmp = (Value Word -> Value Word -> CodeGenFunction r (Value Bool))
-> T Word -> T Word -> CodeGenFunction r (T Bool)
(Repr Word -> Repr Word -> CodeGenFunction r (Repr Bool))
-> T Word -> T Word -> CodeGenFunction r (T Bool)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 ((Value Word -> Value Word -> CodeGenFunction r (Value Bool))
 -> T Word -> T Word -> CodeGenFunction r (T Bool))
-> (CmpPredicate
    -> Value Word -> Value Word -> CodeGenFunction r (Value Bool))
-> CmpPredicate
-> T Word
-> T Word
-> CodeGenFunction r (T Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmpPredicate
-> Value Word -> Value Word -> CodeGenFunction r (Value Bool)
CmpPredicate
-> Value Word
-> Value Word
-> CodeGenFunction r (CmpValueResult Value Value Word)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, CmpRet a) =>
CmpPredicate
-> value0 a
-> value1 a
-> CodeGenFunction r (CmpValueResult value0 value1 a)
LLVM.cmp
instance Comparison Word8 where cmp :: forall r.
CmpPredicate -> T Word8 -> T Word8 -> CodeGenFunction r (T Bool)
cmp = (Value Word8 -> Value Word8 -> CodeGenFunction r (Value Bool))
-> T Word8 -> T Word8 -> CodeGenFunction r (T Bool)
(Repr Word8 -> Repr Word8 -> CodeGenFunction r (Repr Bool))
-> T Word8 -> T Word8 -> CodeGenFunction r (T Bool)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 ((Value Word8 -> Value Word8 -> CodeGenFunction r (Value Bool))
 -> T Word8 -> T Word8 -> CodeGenFunction r (T Bool))
-> (CmpPredicate
    -> Value Word8 -> Value Word8 -> CodeGenFunction r (Value Bool))
-> CmpPredicate
-> T Word8
-> T Word8
-> CodeGenFunction r (T Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmpPredicate
-> Value Word8 -> Value Word8 -> CodeGenFunction r (Value Bool)
CmpPredicate
-> Value Word8
-> Value Word8
-> CodeGenFunction r (CmpValueResult Value Value Word8)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, CmpRet a) =>
CmpPredicate
-> value0 a
-> value1 a
-> CodeGenFunction r (CmpValueResult value0 value1 a)
LLVM.cmp
instance Comparison Word16 where cmp :: forall r.
CmpPredicate -> T Word16 -> T Word16 -> CodeGenFunction r (T Bool)
cmp = (Value Word16 -> Value Word16 -> CodeGenFunction r (Value Bool))
-> T Word16 -> T Word16 -> CodeGenFunction r (T Bool)
(Repr Word16 -> Repr Word16 -> CodeGenFunction r (Repr Bool))
-> T Word16 -> T Word16 -> CodeGenFunction r (T Bool)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 ((Value Word16 -> Value Word16 -> CodeGenFunction r (Value Bool))
 -> T Word16 -> T Word16 -> CodeGenFunction r (T Bool))
-> (CmpPredicate
    -> Value Word16 -> Value Word16 -> CodeGenFunction r (Value Bool))
-> CmpPredicate
-> T Word16
-> T Word16
-> CodeGenFunction r (T Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmpPredicate
-> Value Word16 -> Value Word16 -> CodeGenFunction r (Value Bool)
CmpPredicate
-> Value Word16
-> Value Word16
-> CodeGenFunction r (CmpValueResult Value Value Word16)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, CmpRet a) =>
CmpPredicate
-> value0 a
-> value1 a
-> CodeGenFunction r (CmpValueResult value0 value1 a)
LLVM.cmp
instance Comparison Word32 where cmp :: forall r.
CmpPredicate -> T Word32 -> T Word32 -> CodeGenFunction r (T Bool)
cmp = (Value Word32 -> Value Word32 -> CodeGenFunction r (Value Bool))
-> T Word32 -> T Word32 -> CodeGenFunction r (T Bool)
(Repr Word32 -> Repr Word32 -> CodeGenFunction r (Repr Bool))
-> T Word32 -> T Word32 -> CodeGenFunction r (T Bool)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 ((Value Word32 -> Value Word32 -> CodeGenFunction r (Value Bool))
 -> T Word32 -> T Word32 -> CodeGenFunction r (T Bool))
-> (CmpPredicate
    -> Value Word32 -> Value Word32 -> CodeGenFunction r (Value Bool))
-> CmpPredicate
-> T Word32
-> T Word32
-> CodeGenFunction r (T Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmpPredicate
-> Value Word32 -> Value Word32 -> CodeGenFunction r (Value Bool)
CmpPredicate
-> Value Word32
-> Value Word32
-> CodeGenFunction r (CmpValueResult Value Value Word32)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, CmpRet a) =>
CmpPredicate
-> value0 a
-> value1 a
-> CodeGenFunction r (CmpValueResult value0 value1 a)
LLVM.cmp
instance Comparison Word64 where cmp :: forall r.
CmpPredicate -> T Word64 -> T Word64 -> CodeGenFunction r (T Bool)
cmp = (Value Word64 -> Value Word64 -> CodeGenFunction r (Value Bool))
-> T Word64 -> T Word64 -> CodeGenFunction r (T Bool)
(Repr Word64 -> Repr Word64 -> CodeGenFunction r (Repr Bool))
-> T Word64 -> T Word64 -> CodeGenFunction r (T Bool)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 ((Value Word64 -> Value Word64 -> CodeGenFunction r (Value Bool))
 -> T Word64 -> T Word64 -> CodeGenFunction r (T Bool))
-> (CmpPredicate
    -> Value Word64 -> Value Word64 -> CodeGenFunction r (Value Bool))
-> CmpPredicate
-> T Word64
-> T Word64
-> CodeGenFunction r (T Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmpPredicate
-> Value Word64 -> Value Word64 -> CodeGenFunction r (Value Bool)
CmpPredicate
-> Value Word64
-> Value Word64
-> CodeGenFunction r (CmpValueResult Value Value Word64)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, CmpRet a) =>
CmpPredicate
-> value0 a
-> value1 a
-> CodeGenFunction r (CmpValueResult value0 value1 a)
LLVM.cmp

instance (Dec.Positive n) => Comparison (IntN n) where cmp :: forall r.
CmpPredicate
-> T (IntN n) -> T (IntN n) -> CodeGenFunction r (T Bool)
cmp = (Value (IntN n)
 -> Value (IntN n) -> CodeGenFunction r (Value Bool))
-> T (IntN n) -> T (IntN n) -> CodeGenFunction r (T Bool)
(Repr (IntN n) -> Repr (IntN n) -> CodeGenFunction r (Repr Bool))
-> T (IntN n) -> T (IntN n) -> CodeGenFunction r (T Bool)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 ((Value (IntN n)
  -> Value (IntN n) -> CodeGenFunction r (Value Bool))
 -> T (IntN n) -> T (IntN n) -> CodeGenFunction r (T Bool))
-> (CmpPredicate
    -> Value (IntN n)
    -> Value (IntN n)
    -> CodeGenFunction r (Value Bool))
-> CmpPredicate
-> T (IntN n)
-> T (IntN n)
-> CodeGenFunction r (T Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmpPredicate
-> Value (IntN n)
-> Value (IntN n)
-> CodeGenFunction r (Value Bool)
CmpPredicate
-> Value (IntN n)
-> Value (IntN n)
-> CodeGenFunction r (CmpValueResult Value Value (IntN n))
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, CmpRet a) =>
CmpPredicate
-> value0 a
-> value1 a
-> CodeGenFunction r (CmpValueResult value0 value1 a)
LLVM.cmp
instance (Dec.Positive n) => Comparison (WordN n) where cmp :: forall r.
CmpPredicate
-> T (WordN n) -> T (WordN n) -> CodeGenFunction r (T Bool)
cmp = (Value (WordN n)
 -> Value (WordN n) -> CodeGenFunction r (Value Bool))
-> T (WordN n) -> T (WordN n) -> CodeGenFunction r (T Bool)
(Repr (WordN n) -> Repr (WordN n) -> CodeGenFunction r (Repr Bool))
-> T (WordN n) -> T (WordN n) -> CodeGenFunction r (T Bool)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 ((Value (WordN n)
  -> Value (WordN n) -> CodeGenFunction r (Value Bool))
 -> T (WordN n) -> T (WordN n) -> CodeGenFunction r (T Bool))
-> (CmpPredicate
    -> Value (WordN n)
    -> Value (WordN n)
    -> CodeGenFunction r (Value Bool))
-> CmpPredicate
-> T (WordN n)
-> T (WordN n)
-> CodeGenFunction r (T Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmpPredicate
-> Value (WordN n)
-> Value (WordN n)
-> CodeGenFunction r (Value Bool)
CmpPredicate
-> Value (WordN n)
-> Value (WordN n)
-> CodeGenFunction r (CmpValueResult Value Value (WordN n))
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, CmpRet a) =>
CmpPredicate
-> value0 a
-> value1 a
-> CodeGenFunction r (CmpValueResult value0 value1 a)
LLVM.cmp

instance (Comparison a) => Comparison (Tagged tag a) where
   cmp :: forall r.
CmpPredicate
-> T (Tagged tag a)
-> T (Tagged tag a)
-> CodeGenFunction r (T Bool)
cmp CmpPredicate
p T (Tagged tag a)
a T (Tagged tag a)
b = CmpPredicate -> T a -> T a -> CodeGenFunction r (T Bool)
forall r. CmpPredicate -> T a -> T a -> CodeGenFunction r (T Bool)
forall a r.
Comparison a =>
CmpPredicate -> T a -> T a -> CodeGenFunction r (T Bool)
cmp CmpPredicate
p (T (Tagged tag a) -> T a
forall tag a. T (Tagged tag a) -> T a
untag T (Tagged tag a)
a) (T (Tagged tag a) -> T a
forall tag a. T (Tagged tag a) -> T a
untag T (Tagged tag a)
b)

instance (Comparison a) => A.Comparison (T a) where
   type CmpResult (T a) = T Bool
   cmp :: forall r.
CmpPredicate -> T a -> T a -> CodeGenFunction r (CmpResult (T a))
cmp = CmpPredicate -> T a -> T a -> CodeGenFunction r (CmpResult (T a))
CmpPredicate -> T a -> T a -> CodeGenFunction r (T Bool)
forall r. CmpPredicate -> T a -> T a -> CodeGenFunction r (T Bool)
forall a r.
Comparison a =>
CmpPredicate -> T a -> T a -> CodeGenFunction r (T Bool)
cmp



class (Comparison a) => FloatingComparison a where
   fcmp ::
      LLVM.FPPredicate -> T a -> T a ->
      LLVM.CodeGenFunction r (T Bool)

instance FloatingComparison Float where
   fcmp :: forall r.
FPPredicate -> T Float -> T Float -> CodeGenFunction r (T Bool)
fcmp = (Value Float -> Value Float -> CodeGenFunction r (Value Bool))
-> T Float -> T Float -> CodeGenFunction r (T Bool)
(Repr Float -> Repr Float -> CodeGenFunction r (Repr Bool))
-> T Float -> T Float -> CodeGenFunction r (T Bool)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 ((Value Float -> Value Float -> CodeGenFunction r (Value Bool))
 -> T Float -> T Float -> CodeGenFunction r (T Bool))
-> (FPPredicate
    -> Value Float -> Value Float -> CodeGenFunction r (Value Bool))
-> FPPredicate
-> T Float
-> T Float
-> CodeGenFunction r (T Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FPPredicate
-> Value Float -> Value Float -> CodeGenFunction r (Value Bool)
FPPredicate
-> Value Float
-> Value Float
-> CodeGenFunction r (CmpValueResult Value Value Float)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, CmpRet a, IsFloating a) =>
FPPredicate
-> value0 a
-> value1 a
-> CodeGenFunction r (CmpValueResult value0 value1 a)
LLVM.fcmp

instance (FloatingComparison a) => FloatingComparison (Tagged tag a) where
   fcmp :: forall r.
FPPredicate
-> T (Tagged tag a)
-> T (Tagged tag a)
-> CodeGenFunction r (T Bool)
fcmp FPPredicate
p T (Tagged tag a)
a T (Tagged tag a)
b = FPPredicate -> T a -> T a -> CodeGenFunction r (T Bool)
forall r. FPPredicate -> T a -> T a -> CodeGenFunction r (T Bool)
forall a r.
FloatingComparison a =>
FPPredicate -> T a -> T a -> CodeGenFunction r (T Bool)
fcmp FPPredicate
p (T (Tagged tag a) -> T a
forall tag a. T (Tagged tag a) -> T a
untag T (Tagged tag a)
a) (T (Tagged tag a) -> T a
forall tag a. T (Tagged tag a) -> T a
untag T (Tagged tag a)
b)

instance (FloatingComparison a) => A.FloatingComparison (T a) where
   fcmp :: forall r.
FPPredicate -> T a -> T a -> CodeGenFunction r (CmpResult (T a))
fcmp = FPPredicate -> T a -> T a -> CodeGenFunction r (CmpResult (T a))
FPPredicate -> T a -> T a -> CodeGenFunction r (T Bool)
forall r. FPPredicate -> T a -> T a -> CodeGenFunction r (T Bool)
forall a r.
FloatingComparison a =>
FPPredicate -> T a -> T a -> CodeGenFunction r (T Bool)
fcmp



class (C a) => Logic a where
   and :: T a -> T a -> LLVM.CodeGenFunction r (T a)
   or :: T a -> T a -> LLVM.CodeGenFunction r (T a)
   xor :: T a -> T a -> LLVM.CodeGenFunction r (T a)
   inv :: T a -> LLVM.CodeGenFunction r (T a)

instance Logic Bool where
   and :: forall r. T Bool -> T Bool -> CodeGenFunction r (T Bool)
and = (Repr Bool -> Repr Bool -> CodeGenFunction r (Repr Bool))
-> T Bool -> T Bool -> CodeGenFunction r (T Bool)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Bool
-> Value Bool -> CodeGenFunction r (BinOpValue Value Value Bool)
Repr Bool -> Repr Bool -> CodeGenFunction r (Repr Bool)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.and; or :: forall r. T Bool -> T Bool -> CodeGenFunction r (T Bool)
or = (Repr Bool -> Repr Bool -> CodeGenFunction r (Repr Bool))
-> T Bool -> T Bool -> CodeGenFunction r (T Bool)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Bool
-> Value Bool -> CodeGenFunction r (BinOpValue Value Value Bool)
Repr Bool -> Repr Bool -> CodeGenFunction r (Repr Bool)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.or
   xor :: forall r. T Bool -> T Bool -> CodeGenFunction r (T Bool)
xor = (Repr Bool -> Repr Bool -> CodeGenFunction r (Repr Bool))
-> T Bool -> T Bool -> CodeGenFunction r (T Bool)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Bool
-> Value Bool -> CodeGenFunction r (BinOpValue Value Value Bool)
Repr Bool -> Repr Bool -> CodeGenFunction r (Repr Bool)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.xor; inv :: forall r. T Bool -> CodeGenFunction r (T Bool)
inv = (Repr Bool -> CodeGenFunction r (Repr Bool))
-> T Bool -> CodeGenFunction r (T Bool)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Bool -> CodeGenFunction r (Value Bool)
Repr Bool -> CodeGenFunction r (Repr Bool)
forall (value :: * -> *) a r.
(ValueCons value, IsInteger a) =>
value a -> CodeGenFunction r (value a)
LLVM.inv

instance Logic Bool8 where
   and :: forall r. T Bool8 -> T Bool8 -> CodeGenFunction r (T Bool8)
and = (Repr Bool8 -> Repr Bool8 -> CodeGenFunction r (Repr Bool8))
-> T Bool8 -> T Bool8 -> CodeGenFunction r (T Bool8)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Bool
-> Value Bool -> CodeGenFunction r (BinOpValue Value Value Bool)
Repr Bool8 -> Repr Bool8 -> CodeGenFunction r (Repr Bool8)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.and; or :: forall r. T Bool8 -> T Bool8 -> CodeGenFunction r (T Bool8)
or = (Repr Bool8 -> Repr Bool8 -> CodeGenFunction r (Repr Bool8))
-> T Bool8 -> T Bool8 -> CodeGenFunction r (T Bool8)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Bool
-> Value Bool -> CodeGenFunction r (BinOpValue Value Value Bool)
Repr Bool8 -> Repr Bool8 -> CodeGenFunction r (Repr Bool8)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.or
   xor :: forall r. T Bool8 -> T Bool8 -> CodeGenFunction r (T Bool8)
xor = (Repr Bool8 -> Repr Bool8 -> CodeGenFunction r (Repr Bool8))
-> T Bool8 -> T Bool8 -> CodeGenFunction r (T Bool8)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Bool
-> Value Bool -> CodeGenFunction r (BinOpValue Value Value Bool)
Repr Bool8 -> Repr Bool8 -> CodeGenFunction r (Repr Bool8)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.xor; inv :: forall r. T Bool8 -> CodeGenFunction r (T Bool8)
inv = (Repr Bool8 -> CodeGenFunction r (Repr Bool8))
-> T Bool8 -> CodeGenFunction r (T Bool8)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Bool -> CodeGenFunction r (Value Bool)
Repr Bool8 -> CodeGenFunction r (Repr Bool8)
forall (value :: * -> *) a r.
(ValueCons value, IsInteger a) =>
value a -> CodeGenFunction r (value a)
LLVM.inv

instance Logic Word8 where
   and :: forall r. T Word8 -> T Word8 -> CodeGenFunction r (T Word8)
and = (Repr Word8 -> Repr Word8 -> CodeGenFunction r (Repr Word8))
-> T Word8 -> T Word8 -> CodeGenFunction r (T Word8)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word8
-> Value Word8 -> CodeGenFunction r (BinOpValue Value Value Word8)
Repr Word8 -> Repr Word8 -> CodeGenFunction r (Repr Word8)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.and; or :: forall r. T Word8 -> T Word8 -> CodeGenFunction r (T Word8)
or = (Repr Word8 -> Repr Word8 -> CodeGenFunction r (Repr Word8))
-> T Word8 -> T Word8 -> CodeGenFunction r (T Word8)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word8
-> Value Word8 -> CodeGenFunction r (BinOpValue Value Value Word8)
Repr Word8 -> Repr Word8 -> CodeGenFunction r (Repr Word8)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.or
   xor :: forall r. T Word8 -> T Word8 -> CodeGenFunction r (T Word8)
xor = (Repr Word8 -> Repr Word8 -> CodeGenFunction r (Repr Word8))
-> T Word8 -> T Word8 -> CodeGenFunction r (T Word8)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word8
-> Value Word8 -> CodeGenFunction r (BinOpValue Value Value Word8)
Repr Word8 -> Repr Word8 -> CodeGenFunction r (Repr Word8)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.xor; inv :: forall r. T Word8 -> CodeGenFunction r (T Word8)
inv = (Repr Word8 -> CodeGenFunction r (Repr Word8))
-> T Word8 -> CodeGenFunction r (T Word8)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Word8 -> CodeGenFunction r (Value Word8)
Repr Word8 -> CodeGenFunction r (Repr Word8)
forall (value :: * -> *) a r.
(ValueCons value, IsInteger a) =>
value a -> CodeGenFunction r (value a)
LLVM.inv

instance Logic Word16 where
   and :: forall r. T Word16 -> T Word16 -> CodeGenFunction r (T Word16)
and = (Repr Word16 -> Repr Word16 -> CodeGenFunction r (Repr Word16))
-> T Word16 -> T Word16 -> CodeGenFunction r (T Word16)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word16
-> Value Word16
-> CodeGenFunction r (BinOpValue Value Value Word16)
Repr Word16 -> Repr Word16 -> CodeGenFunction r (Repr Word16)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.and; or :: forall r. T Word16 -> T Word16 -> CodeGenFunction r (T Word16)
or = (Repr Word16 -> Repr Word16 -> CodeGenFunction r (Repr Word16))
-> T Word16 -> T Word16 -> CodeGenFunction r (T Word16)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word16
-> Value Word16
-> CodeGenFunction r (BinOpValue Value Value Word16)
Repr Word16 -> Repr Word16 -> CodeGenFunction r (Repr Word16)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.or
   xor :: forall r. T Word16 -> T Word16 -> CodeGenFunction r (T Word16)
xor = (Repr Word16 -> Repr Word16 -> CodeGenFunction r (Repr Word16))
-> T Word16 -> T Word16 -> CodeGenFunction r (T Word16)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word16
-> Value Word16
-> CodeGenFunction r (BinOpValue Value Value Word16)
Repr Word16 -> Repr Word16 -> CodeGenFunction r (Repr Word16)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.xor; inv :: forall r. T Word16 -> CodeGenFunction r (T Word16)
inv = (Repr Word16 -> CodeGenFunction r (Repr Word16))
-> T Word16 -> CodeGenFunction r (T Word16)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Word16 -> CodeGenFunction r (Value Word16)
Repr Word16 -> CodeGenFunction r (Repr Word16)
forall (value :: * -> *) a r.
(ValueCons value, IsInteger a) =>
value a -> CodeGenFunction r (value a)
LLVM.inv

instance Logic Word32 where
   and :: forall r. T Word32 -> T Word32 -> CodeGenFunction r (T Word32)
and = (Repr Word32 -> Repr Word32 -> CodeGenFunction r (Repr Word32))
-> T Word32 -> T Word32 -> CodeGenFunction r (T Word32)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word32
-> Value Word32
-> CodeGenFunction r (BinOpValue Value Value Word32)
Repr Word32 -> Repr Word32 -> CodeGenFunction r (Repr Word32)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.and; or :: forall r. T Word32 -> T Word32 -> CodeGenFunction r (T Word32)
or = (Repr Word32 -> Repr Word32 -> CodeGenFunction r (Repr Word32))
-> T Word32 -> T Word32 -> CodeGenFunction r (T Word32)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word32
-> Value Word32
-> CodeGenFunction r (BinOpValue Value Value Word32)
Repr Word32 -> Repr Word32 -> CodeGenFunction r (Repr Word32)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.or
   xor :: forall r. T Word32 -> T Word32 -> CodeGenFunction r (T Word32)
xor = (Repr Word32 -> Repr Word32 -> CodeGenFunction r (Repr Word32))
-> T Word32 -> T Word32 -> CodeGenFunction r (T Word32)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word32
-> Value Word32
-> CodeGenFunction r (BinOpValue Value Value Word32)
Repr Word32 -> Repr Word32 -> CodeGenFunction r (Repr Word32)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.xor; inv :: forall r. T Word32 -> CodeGenFunction r (T Word32)
inv = (Repr Word32 -> CodeGenFunction r (Repr Word32))
-> T Word32 -> CodeGenFunction r (T Word32)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Word32 -> CodeGenFunction r (Value Word32)
Repr Word32 -> CodeGenFunction r (Repr Word32)
forall (value :: * -> *) a r.
(ValueCons value, IsInteger a) =>
value a -> CodeGenFunction r (value a)
LLVM.inv

instance Logic Word64 where
   and :: forall r. T Word64 -> T Word64 -> CodeGenFunction r (T Word64)
and = (Repr Word64 -> Repr Word64 -> CodeGenFunction r (Repr Word64))
-> T Word64 -> T Word64 -> CodeGenFunction r (T Word64)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word64
-> Value Word64
-> CodeGenFunction r (BinOpValue Value Value Word64)
Repr Word64 -> Repr Word64 -> CodeGenFunction r (Repr Word64)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.and; or :: forall r. T Word64 -> T Word64 -> CodeGenFunction r (T Word64)
or = (Repr Word64 -> Repr Word64 -> CodeGenFunction r (Repr Word64))
-> T Word64 -> T Word64 -> CodeGenFunction r (T Word64)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word64
-> Value Word64
-> CodeGenFunction r (BinOpValue Value Value Word64)
Repr Word64 -> Repr Word64 -> CodeGenFunction r (Repr Word64)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.or
   xor :: forall r. T Word64 -> T Word64 -> CodeGenFunction r (T Word64)
xor = (Repr Word64 -> Repr Word64 -> CodeGenFunction r (Repr Word64))
-> T Word64 -> T Word64 -> CodeGenFunction r (T Word64)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word64
-> Value Word64
-> CodeGenFunction r (BinOpValue Value Value Word64)
Repr Word64 -> Repr Word64 -> CodeGenFunction r (Repr Word64)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.xor; inv :: forall r. T Word64 -> CodeGenFunction r (T Word64)
inv = (Repr Word64 -> CodeGenFunction r (Repr Word64))
-> T Word64 -> CodeGenFunction r (T Word64)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value Word64 -> CodeGenFunction r (Value Word64)
Repr Word64 -> CodeGenFunction r (Repr Word64)
forall (value :: * -> *) a r.
(ValueCons value, IsInteger a) =>
value a -> CodeGenFunction r (value a)
LLVM.inv

instance (Dec.Positive n) => Logic (WordN n) where
   and :: forall r.
T (WordN n) -> T (WordN n) -> CodeGenFunction r (T (WordN n))
and = (Repr (WordN n)
 -> Repr (WordN n) -> CodeGenFunction r (Repr (WordN n)))
-> T (WordN n) -> T (WordN n) -> CodeGenFunction r (T (WordN n))
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value (WordN n)
-> Value (WordN n)
-> CodeGenFunction r (BinOpValue Value Value (WordN n))
Repr (WordN n)
-> Repr (WordN n) -> CodeGenFunction r (Repr (WordN n))
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.and; or :: forall r.
T (WordN n) -> T (WordN n) -> CodeGenFunction r (T (WordN n))
or = (Repr (WordN n)
 -> Repr (WordN n) -> CodeGenFunction r (Repr (WordN n)))
-> T (WordN n) -> T (WordN n) -> CodeGenFunction r (T (WordN n))
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value (WordN n)
-> Value (WordN n)
-> CodeGenFunction r (BinOpValue Value Value (WordN n))
Repr (WordN n)
-> Repr (WordN n) -> CodeGenFunction r (Repr (WordN n))
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.or
   xor :: forall r.
T (WordN n) -> T (WordN n) -> CodeGenFunction r (T (WordN n))
xor = (Repr (WordN n)
 -> Repr (WordN n) -> CodeGenFunction r (Repr (WordN n)))
-> T (WordN n) -> T (WordN n) -> CodeGenFunction r (T (WordN n))
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value (WordN n)
-> Value (WordN n)
-> CodeGenFunction r (BinOpValue Value Value (WordN n))
Repr (WordN n)
-> Repr (WordN n) -> CodeGenFunction r (Repr (WordN n))
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.xor; inv :: forall r. T (WordN n) -> CodeGenFunction r (T (WordN n))
inv = (Repr (WordN n) -> CodeGenFunction r (Repr (WordN n)))
-> T (WordN n) -> CodeGenFunction r (T (WordN n))
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value (WordN n) -> CodeGenFunction r (Value (WordN n))
Repr (WordN n) -> CodeGenFunction r (Repr (WordN n))
forall (value :: * -> *) a r.
(ValueCons value, IsInteger a) =>
value a -> CodeGenFunction r (value a)
LLVM.inv

instance (LLVM.IsInteger w, LLVM.IsConst w) => Logic (EnumBitSet.T w i) where
   and :: forall r. T (T w i) -> T (T w i) -> CodeGenFunction r (T (T w i))
and = (Repr (T w i) -> Repr (T w i) -> CodeGenFunction r (Repr (T w i)))
-> T (T w i) -> T (T w i) -> CodeGenFunction r (T (T w i))
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value w -> Value w -> CodeGenFunction r (BinOpValue Value Value w)
Repr (T w i) -> Repr (T w i) -> CodeGenFunction r (Repr (T w i))
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.and; or :: forall r. T (T w i) -> T (T w i) -> CodeGenFunction r (T (T w i))
or = (Repr (T w i) -> Repr (T w i) -> CodeGenFunction r (Repr (T w i)))
-> T (T w i) -> T (T w i) -> CodeGenFunction r (T (T w i))
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value w -> Value w -> CodeGenFunction r (BinOpValue Value Value w)
Repr (T w i) -> Repr (T w i) -> CodeGenFunction r (Repr (T w i))
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.or
   xor :: forall r. T (T w i) -> T (T w i) -> CodeGenFunction r (T (T w i))
xor = (Repr (T w i) -> Repr (T w i) -> CodeGenFunction r (Repr (T w i)))
-> T (T w i) -> T (T w i) -> CodeGenFunction r (T (T w i))
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value w -> Value w -> CodeGenFunction r (BinOpValue Value Value w)
Repr (T w i) -> Repr (T w i) -> CodeGenFunction r (Repr (T w i))
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.xor; inv :: forall r. T (T w i) -> CodeGenFunction r (T (T w i))
inv = (Repr (T w i) -> CodeGenFunction r (Repr (T w i)))
-> T (T w i) -> CodeGenFunction r (T (T w i))
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value w -> CodeGenFunction r (Value w)
Repr (T w i) -> CodeGenFunction r (Repr (T w i))
forall (value :: * -> *) a r.
(ValueCons value, IsInteger a) =>
value a -> CodeGenFunction r (value a)
LLVM.inv

instance Logic a => Logic (Tagged tag a) where
   and :: forall r.
T (Tagged tag a)
-> T (Tagged tag a) -> CodeGenFunction r (T (Tagged tag a))
and = (T a -> T a -> CodeGenFunction r (T a))
-> T (Tagged tag a)
-> T (Tagged tag a)
-> CodeGenFunction r (T (Tagged tag a))
forall (m :: * -> *) a b c tag.
Monad m =>
(T a -> T b -> m (T c))
-> T (Tagged tag a) -> T (Tagged tag b) -> m (T (Tagged tag c))
liftTaggedM2 T a -> T a -> CodeGenFunction r (T a)
forall a r. Logic a => T a -> T a -> CodeGenFunction r (T a)
forall r. T a -> T a -> CodeGenFunction r (T a)
and; or :: forall r.
T (Tagged tag a)
-> T (Tagged tag a) -> CodeGenFunction r (T (Tagged tag a))
or = (T a -> T a -> CodeGenFunction r (T a))
-> T (Tagged tag a)
-> T (Tagged tag a)
-> CodeGenFunction r (T (Tagged tag a))
forall (m :: * -> *) a b c tag.
Monad m =>
(T a -> T b -> m (T c))
-> T (Tagged tag a) -> T (Tagged tag b) -> m (T (Tagged tag c))
liftTaggedM2 T a -> T a -> CodeGenFunction r (T a)
forall a r. Logic a => T a -> T a -> CodeGenFunction r (T a)
forall r. T a -> T a -> CodeGenFunction r (T a)
or
   xor :: forall r.
T (Tagged tag a)
-> T (Tagged tag a) -> CodeGenFunction r (T (Tagged tag a))
xor = (T a -> T a -> CodeGenFunction r (T a))
-> T (Tagged tag a)
-> T (Tagged tag a)
-> CodeGenFunction r (T (Tagged tag a))
forall (m :: * -> *) a b c tag.
Monad m =>
(T a -> T b -> m (T c))
-> T (Tagged tag a) -> T (Tagged tag b) -> m (T (Tagged tag c))
liftTaggedM2 T a -> T a -> CodeGenFunction r (T a)
forall a r. Logic a => T a -> T a -> CodeGenFunction r (T a)
forall r. T a -> T a -> CodeGenFunction r (T a)
xor; inv :: forall r. T (Tagged tag a) -> CodeGenFunction r (T (Tagged tag a))
inv = (T a -> CodeGenFunction r (T a))
-> T (Tagged tag a) -> CodeGenFunction r (T (Tagged tag a))
forall (m :: * -> *) a b tag.
Monad m =>
(T a -> m (T b)) -> T (Tagged tag a) -> m (T (Tagged tag b))
liftTaggedM T a -> CodeGenFunction r (T a)
forall a r. Logic a => T a -> CodeGenFunction r (T a)
forall r. T a -> CodeGenFunction r (T a)
inv


instance Logic a => A.Logic (T a) where
   and :: forall r. T a -> T a -> CodeGenFunction r (T a)
and = T a -> T a -> CodeGenFunction r (T a)
forall a r. Logic a => T a -> T a -> CodeGenFunction r (T a)
forall r. T a -> T a -> CodeGenFunction r (T a)
and
   or :: forall r. T a -> T a -> CodeGenFunction r (T a)
or = T a -> T a -> CodeGenFunction r (T a)
forall a r. Logic a => T a -> T a -> CodeGenFunction r (T a)
forall r. T a -> T a -> CodeGenFunction r (T a)
or
   xor :: forall r. T a -> T a -> CodeGenFunction r (T a)
xor = T a -> T a -> CodeGenFunction r (T a)
forall a r. Logic a => T a -> T a -> CodeGenFunction r (T a)
forall r. T a -> T a -> CodeGenFunction r (T a)
xor
   inv :: forall r. T a -> CodeGenFunction r (T a)
inv = T a -> CodeGenFunction r (T a)
forall a r. Logic a => T a -> CodeGenFunction r (T a)
forall r. T a -> CodeGenFunction r (T a)
inv



class BitShift a where
   shl :: T a -> T a -> LLVM.CodeGenFunction r (T a)
   shr :: T a -> T a -> LLVM.CodeGenFunction r (T a)

instance BitShift Word where
   shl :: forall r. T Word -> T Word -> CodeGenFunction r (T Word)
shl = (Repr Word -> Repr Word -> CodeGenFunction r (Repr Word))
-> T Word -> T Word -> CodeGenFunction r (T Word)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word
-> Value Word -> CodeGenFunction r (BinOpValue Value Value Word)
Repr Word -> Repr Word -> CodeGenFunction r (Repr Word)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.shl; shr :: forall r. T Word -> T Word -> CodeGenFunction r (T Word)
shr = (Repr Word -> Repr Word -> CodeGenFunction r (Repr Word))
-> T Word -> T Word -> CodeGenFunction r (T Word)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word
-> Value Word -> CodeGenFunction r (BinOpValue Value Value Word)
Repr Word -> Repr Word -> CodeGenFunction r (Repr Word)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.lshr

instance BitShift Word8 where
   shl :: forall r. T Word8 -> T Word8 -> CodeGenFunction r (T Word8)
shl = (Repr Word8 -> Repr Word8 -> CodeGenFunction r (Repr Word8))
-> T Word8 -> T Word8 -> CodeGenFunction r (T Word8)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word8
-> Value Word8 -> CodeGenFunction r (BinOpValue Value Value Word8)
Repr Word8 -> Repr Word8 -> CodeGenFunction r (Repr Word8)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.shl; shr :: forall r. T Word8 -> T Word8 -> CodeGenFunction r (T Word8)
shr = (Repr Word8 -> Repr Word8 -> CodeGenFunction r (Repr Word8))
-> T Word8 -> T Word8 -> CodeGenFunction r (T Word8)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word8
-> Value Word8 -> CodeGenFunction r (BinOpValue Value Value Word8)
Repr Word8 -> Repr Word8 -> CodeGenFunction r (Repr Word8)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.lshr

instance BitShift Word16 where
   shl :: forall r. T Word16 -> T Word16 -> CodeGenFunction r (T Word16)
shl = (Repr Word16 -> Repr Word16 -> CodeGenFunction r (Repr Word16))
-> T Word16 -> T Word16 -> CodeGenFunction r (T Word16)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word16
-> Value Word16
-> CodeGenFunction r (BinOpValue Value Value Word16)
Repr Word16 -> Repr Word16 -> CodeGenFunction r (Repr Word16)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.shl; shr :: forall r. T Word16 -> T Word16 -> CodeGenFunction r (T Word16)
shr = (Repr Word16 -> Repr Word16 -> CodeGenFunction r (Repr Word16))
-> T Word16 -> T Word16 -> CodeGenFunction r (T Word16)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word16
-> Value Word16
-> CodeGenFunction r (BinOpValue Value Value Word16)
Repr Word16 -> Repr Word16 -> CodeGenFunction r (Repr Word16)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.lshr

instance BitShift Word32 where
   shl :: forall r. T Word32 -> T Word32 -> CodeGenFunction r (T Word32)
shl = (Repr Word32 -> Repr Word32 -> CodeGenFunction r (Repr Word32))
-> T Word32 -> T Word32 -> CodeGenFunction r (T Word32)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word32
-> Value Word32
-> CodeGenFunction r (BinOpValue Value Value Word32)
Repr Word32 -> Repr Word32 -> CodeGenFunction r (Repr Word32)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.shl; shr :: forall r. T Word32 -> T Word32 -> CodeGenFunction r (T Word32)
shr = (Repr Word32 -> Repr Word32 -> CodeGenFunction r (Repr Word32))
-> T Word32 -> T Word32 -> CodeGenFunction r (T Word32)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word32
-> Value Word32
-> CodeGenFunction r (BinOpValue Value Value Word32)
Repr Word32 -> Repr Word32 -> CodeGenFunction r (Repr Word32)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.lshr

instance BitShift Word64 where
   shl :: forall r. T Word64 -> T Word64 -> CodeGenFunction r (T Word64)
shl = (Repr Word64 -> Repr Word64 -> CodeGenFunction r (Repr Word64))
-> T Word64 -> T Word64 -> CodeGenFunction r (T Word64)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word64
-> Value Word64
-> CodeGenFunction r (BinOpValue Value Value Word64)
Repr Word64 -> Repr Word64 -> CodeGenFunction r (Repr Word64)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.shl; shr :: forall r. T Word64 -> T Word64 -> CodeGenFunction r (T Word64)
shr = (Repr Word64 -> Repr Word64 -> CodeGenFunction r (Repr Word64))
-> T Word64 -> T Word64 -> CodeGenFunction r (T Word64)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word64
-> Value Word64
-> CodeGenFunction r (BinOpValue Value Value Word64)
Repr Word64 -> Repr Word64 -> CodeGenFunction r (Repr Word64)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.lshr

instance BitShift Int where
   shl :: forall r. T Int -> T Int -> CodeGenFunction r (T Int)
shl = (Repr Int -> Repr Int -> CodeGenFunction r (Repr Int))
-> T Int -> T Int -> CodeGenFunction r (T Int)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int
-> Value Int -> CodeGenFunction r (BinOpValue Value Value Int)
Repr Int -> Repr Int -> CodeGenFunction r (Repr Int)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.shl; shr :: forall r. T Int -> T Int -> CodeGenFunction r (T Int)
shr = (Repr Int -> Repr Int -> CodeGenFunction r (Repr Int))
-> T Int -> T Int -> CodeGenFunction r (T Int)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int
-> Value Int -> CodeGenFunction r (BinOpValue Value Value Int)
Repr Int -> Repr Int -> CodeGenFunction r (Repr Int)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.ashr

instance BitShift Int8 where
   shl :: forall r. T Int8 -> T Int8 -> CodeGenFunction r (T Int8)
shl = (Repr Int8 -> Repr Int8 -> CodeGenFunction r (Repr Int8))
-> T Int8 -> T Int8 -> CodeGenFunction r (T Int8)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int8
-> Value Int8 -> CodeGenFunction r (BinOpValue Value Value Int8)
Repr Int8 -> Repr Int8 -> CodeGenFunction r (Repr Int8)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.shl; shr :: forall r. T Int8 -> T Int8 -> CodeGenFunction r (T Int8)
shr = (Repr Int8 -> Repr Int8 -> CodeGenFunction r (Repr Int8))
-> T Int8 -> T Int8 -> CodeGenFunction r (T Int8)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int8
-> Value Int8 -> CodeGenFunction r (BinOpValue Value Value Int8)
Repr Int8 -> Repr Int8 -> CodeGenFunction r (Repr Int8)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.ashr

instance BitShift Int16 where
   shl :: forall r. T Int16 -> T Int16 -> CodeGenFunction r (T Int16)
shl = (Repr Int16 -> Repr Int16 -> CodeGenFunction r (Repr Int16))
-> T Int16 -> T Int16 -> CodeGenFunction r (T Int16)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int16
-> Value Int16 -> CodeGenFunction r (BinOpValue Value Value Int16)
Repr Int16 -> Repr Int16 -> CodeGenFunction r (Repr Int16)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.shl; shr :: forall r. T Int16 -> T Int16 -> CodeGenFunction r (T Int16)
shr = (Repr Int16 -> Repr Int16 -> CodeGenFunction r (Repr Int16))
-> T Int16 -> T Int16 -> CodeGenFunction r (T Int16)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int16
-> Value Int16 -> CodeGenFunction r (BinOpValue Value Value Int16)
Repr Int16 -> Repr Int16 -> CodeGenFunction r (Repr Int16)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.ashr

instance BitShift Int32 where
   shl :: forall r. T Int32 -> T Int32 -> CodeGenFunction r (T Int32)
shl = (Repr Int32 -> Repr Int32 -> CodeGenFunction r (Repr Int32))
-> T Int32 -> T Int32 -> CodeGenFunction r (T Int32)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int32
-> Value Int32 -> CodeGenFunction r (BinOpValue Value Value Int32)
Repr Int32 -> Repr Int32 -> CodeGenFunction r (Repr Int32)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.shl; shr :: forall r. T Int32 -> T Int32 -> CodeGenFunction r (T Int32)
shr = (Repr Int32 -> Repr Int32 -> CodeGenFunction r (Repr Int32))
-> T Int32 -> T Int32 -> CodeGenFunction r (T Int32)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int32
-> Value Int32 -> CodeGenFunction r (BinOpValue Value Value Int32)
Repr Int32 -> Repr Int32 -> CodeGenFunction r (Repr Int32)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.ashr

instance BitShift Int64 where
   shl :: forall r. T Int64 -> T Int64 -> CodeGenFunction r (T Int64)
shl = (Repr Int64 -> Repr Int64 -> CodeGenFunction r (Repr Int64))
-> T Int64 -> T Int64 -> CodeGenFunction r (T Int64)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int64
-> Value Int64 -> CodeGenFunction r (BinOpValue Value Value Int64)
Repr Int64 -> Repr Int64 -> CodeGenFunction r (Repr Int64)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.shl; shr :: forall r. T Int64 -> T Int64 -> CodeGenFunction r (T Int64)
shr = (Repr Int64 -> Repr Int64 -> CodeGenFunction r (Repr Int64))
-> T Int64 -> T Int64 -> CodeGenFunction r (T Int64)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int64
-> Value Int64 -> CodeGenFunction r (BinOpValue Value Value Int64)
Repr Int64 -> Repr Int64 -> CodeGenFunction r (Repr Int64)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.ashr



class (PseudoRing a) => Integral a where
   idiv :: T a -> T a -> LLVM.CodeGenFunction r (T a)
   irem :: T a -> T a -> LLVM.CodeGenFunction r (T a)

instance Integral Word where
   idiv :: forall r. T Word -> T Word -> CodeGenFunction r (T Word)
idiv = (Repr Word -> Repr Word -> CodeGenFunction r (Repr Word))
-> T Word -> T Word -> CodeGenFunction r (T Word)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word -> Value Word -> CodeGenFunction r (Value Word)
Repr Word -> Repr Word -> CodeGenFunction r (Repr Word)
forall a r.
IsInteger a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.idiv
   irem :: forall r. T Word -> T Word -> CodeGenFunction r (T Word)
irem = (Repr Word -> Repr Word -> CodeGenFunction r (Repr Word))
-> T Word -> T Word -> CodeGenFunction r (T Word)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word -> Value Word -> CodeGenFunction r (Value Word)
Repr Word -> Repr Word -> CodeGenFunction r (Repr Word)
forall a r.
IsInteger a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.irem

instance Integral Word32 where
   idiv :: forall r. T Word32 -> T Word32 -> CodeGenFunction r (T Word32)
idiv = (Repr Word32 -> Repr Word32 -> CodeGenFunction r (Repr Word32))
-> T Word32 -> T Word32 -> CodeGenFunction r (T Word32)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word32 -> Value Word32 -> CodeGenFunction r (Value Word32)
Repr Word32 -> Repr Word32 -> CodeGenFunction r (Repr Word32)
forall a r.
IsInteger a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.idiv
   irem :: forall r. T Word32 -> T Word32 -> CodeGenFunction r (T Word32)
irem = (Repr Word32 -> Repr Word32 -> CodeGenFunction r (Repr Word32))
-> T Word32 -> T Word32 -> CodeGenFunction r (T Word32)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word32 -> Value Word32 -> CodeGenFunction r (Value Word32)
Repr Word32 -> Repr Word32 -> CodeGenFunction r (Repr Word32)
forall a r.
IsInteger a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.irem

instance Integral Word64 where
   idiv :: forall r. T Word64 -> T Word64 -> CodeGenFunction r (T Word64)
idiv = (Repr Word64 -> Repr Word64 -> CodeGenFunction r (Repr Word64))
-> T Word64 -> T Word64 -> CodeGenFunction r (T Word64)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word64 -> Value Word64 -> CodeGenFunction r (Value Word64)
Repr Word64 -> Repr Word64 -> CodeGenFunction r (Repr Word64)
forall a r.
IsInteger a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.idiv
   irem :: forall r. T Word64 -> T Word64 -> CodeGenFunction r (T Word64)
irem = (Repr Word64 -> Repr Word64 -> CodeGenFunction r (Repr Word64))
-> T Word64 -> T Word64 -> CodeGenFunction r (T Word64)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Word64 -> Value Word64 -> CodeGenFunction r (Value Word64)
Repr Word64 -> Repr Word64 -> CodeGenFunction r (Repr Word64)
forall a r.
IsInteger a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.irem

instance Integral Int where
   idiv :: forall r. T Int -> T Int -> CodeGenFunction r (T Int)
idiv = (Repr Int -> Repr Int -> CodeGenFunction r (Repr Int))
-> T Int -> T Int -> CodeGenFunction r (T Int)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int -> Value Int -> CodeGenFunction r (Value Int)
Repr Int -> Repr Int -> CodeGenFunction r (Repr Int)
forall a r.
IsInteger a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.idiv
   irem :: forall r. T Int -> T Int -> CodeGenFunction r (T Int)
irem = (Repr Int -> Repr Int -> CodeGenFunction r (Repr Int))
-> T Int -> T Int -> CodeGenFunction r (T Int)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int -> Value Int -> CodeGenFunction r (Value Int)
Repr Int -> Repr Int -> CodeGenFunction r (Repr Int)
forall a r.
IsInteger a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.irem

instance Integral Int32 where
   idiv :: forall r. T Int32 -> T Int32 -> CodeGenFunction r (T Int32)
idiv = (Repr Int32 -> Repr Int32 -> CodeGenFunction r (Repr Int32))
-> T Int32 -> T Int32 -> CodeGenFunction r (T Int32)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int32 -> Value Int32 -> CodeGenFunction r (Value Int32)
Repr Int32 -> Repr Int32 -> CodeGenFunction r (Repr Int32)
forall a r.
IsInteger a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.idiv
   irem :: forall r. T Int32 -> T Int32 -> CodeGenFunction r (T Int32)
irem = (Repr Int32 -> Repr Int32 -> CodeGenFunction r (Repr Int32))
-> T Int32 -> T Int32 -> CodeGenFunction r (T Int32)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int32 -> Value Int32 -> CodeGenFunction r (Value Int32)
Repr Int32 -> Repr Int32 -> CodeGenFunction r (Repr Int32)
forall a r.
IsInteger a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.irem

instance Integral Int64 where
   idiv :: forall r. T Int64 -> T Int64 -> CodeGenFunction r (T Int64)
idiv = (Repr Int64 -> Repr Int64 -> CodeGenFunction r (Repr Int64))
-> T Int64 -> T Int64 -> CodeGenFunction r (T Int64)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int64 -> Value Int64 -> CodeGenFunction r (Value Int64)
Repr Int64 -> Repr Int64 -> CodeGenFunction r (Repr Int64)
forall a r.
IsInteger a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.idiv
   irem :: forall r. T Int64 -> T Int64 -> CodeGenFunction r (T Int64)
irem = (Repr Int64 -> Repr Int64 -> CodeGenFunction r (Repr Int64))
-> T Int64 -> T Int64 -> CodeGenFunction r (T Int64)
forall (m :: * -> *) a b c.
Monad m =>
(Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c)
liftM2 Value Int64 -> Value Int64 -> CodeGenFunction r (Value Int64)
Repr Int64 -> Repr Int64 -> CodeGenFunction r (Repr Int64)
forall a r.
IsInteger a =>
Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.irem

instance (Integral a) => Integral (Tagged tag a) where
   idiv :: forall r.
T (Tagged tag a)
-> T (Tagged tag a) -> CodeGenFunction r (T (Tagged tag a))
idiv = (T a -> T a -> CodeGenFunction r (T a))
-> T (Tagged tag a)
-> T (Tagged tag a)
-> CodeGenFunction r (T (Tagged tag a))
forall (m :: * -> *) a b c tag.
Monad m =>
(T a -> T b -> m (T c))
-> T (Tagged tag a) -> T (Tagged tag b) -> m (T (Tagged tag c))
liftTaggedM2 T a -> T a -> CodeGenFunction r (T a)
forall a r. Integral a => T a -> T a -> CodeGenFunction r (T a)
forall r. T a -> T a -> CodeGenFunction r (T a)
idiv
   irem :: forall r.
T (Tagged tag a)
-> T (Tagged tag a) -> CodeGenFunction r (T (Tagged tag a))
irem = (T a -> T a -> CodeGenFunction r (T a))
-> T (Tagged tag a)
-> T (Tagged tag a)
-> CodeGenFunction r (T (Tagged tag a))
forall (m :: * -> *) a b c tag.
Monad m =>
(T a -> T b -> m (T c))
-> T (Tagged tag a) -> T (Tagged tag b) -> m (T (Tagged tag c))
liftTaggedM2 T a -> T a -> CodeGenFunction r (T a)
forall a r. Integral a => T a -> T a -> CodeGenFunction r (T a)
forall r. T a -> T a -> CodeGenFunction r (T a)
irem


fromIntegral ::
   (NativeInteger i ir, NativeFloating a ar) =>
   T i -> LLVM.CodeGenFunction r (T a)
fromIntegral :: forall i ir a ar r.
(NativeInteger i ir, NativeFloating a ar) =>
T i -> CodeGenFunction r (T a)
fromIntegral = (Repr i -> CodeGenFunction r (Repr a))
-> T i -> CodeGenFunction r (T a)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
liftM Value ir -> CodeGenFunction r (Value ar)
Repr i -> CodeGenFunction r (Repr a)
forall (value :: * -> *) a b r.
(ValueCons value, IsInteger a, IsFloating b,
 ShapeOf a ~ ShapeOf b) =>
value a -> CodeGenFunction r (value b)
LLVM.inttofp