module LLVM.Extra.Class where
import qualified LLVM.Core as LLVM
import LLVM.Core
(Value, value, valueOf, undef,
Vector,
IsConst, IsType, IsFirstClass, IsPrimitive,
CodeGenFunction, BasicBlock, )
import LLVM.Util.Loop (Phi, phis, addPhis, )
import qualified Data.TypeLevel.Num as TypeNum
import Control.Applicative (pure, liftA2, )
import qualified Control.Applicative as App
import qualified Data.Foldable as Fold
import qualified Data.Traversable as Trav
import Foreign.StablePtr (StablePtr, )
import Foreign.Ptr (Ptr, )
import Data.Word (Word8, Word16, Word32, Word64, )
import Data.Int (Int8, Int16, Int32, Int64, )
import Prelude hiding (and, iterate, map, zipWith, writeFile, )
class Undefined a where
undefTuple :: a
instance Undefined () where
undefTuple = ()
instance (IsFirstClass a) => Undefined (Value a) where
undefTuple = value undef
instance (Undefined a, Undefined b) => Undefined (a, b) where
undefTuple = (undefTuple, undefTuple)
instance (Undefined a, Undefined b, Undefined c) => Undefined (a, b, c) where
undefTuple = (undefTuple, undefTuple, undefTuple)
class Zero a where
zeroTuple :: a
instance Zero () where
zeroTuple = ()
instance (LLVM.IsFirstClass a) => Zero (Value a) where
zeroTuple = LLVM.value LLVM.zero
instance (Zero a, Zero b) => Zero (a, b) where
zeroTuple = (zeroTuple, zeroTuple)
instance (Zero a, Zero b, Zero c) => Zero (a, b, c) where
zeroTuple = (zeroTuple, zeroTuple, zeroTuple)
zeroTuplePointed ::
(Zero a, App.Applicative f) =>
f a
zeroTuplePointed =
pure zeroTuple
class (Undefined llvmValue) =>
MakeValueTuple haskellValue llvmValue | haskellValue -> llvmValue where
valueTupleOf :: haskellValue -> llvmValue
instance (MakeValueTuple ah al, MakeValueTuple bh bl) =>
MakeValueTuple (ah,bh) (al,bl) where
valueTupleOf ~(a,b) = (valueTupleOf a, valueTupleOf b)
instance (MakeValueTuple ah al, MakeValueTuple bh bl, MakeValueTuple ch cl) =>
MakeValueTuple (ah,bh,ch) (al,bl,cl) where
valueTupleOf ~(a,b,c) = (valueTupleOf a, valueTupleOf b, valueTupleOf c)
instance MakeValueTuple Float (Value Float) where valueTupleOf = valueOf
instance MakeValueTuple Double (Value Double) where valueTupleOf = valueOf
instance MakeValueTuple Bool (Value Bool) where valueTupleOf = valueOf
instance MakeValueTuple Int8 (Value Int8) where valueTupleOf = valueOf
instance MakeValueTuple Int16 (Value Int16) where valueTupleOf = valueOf
instance MakeValueTuple Int32 (Value Int32) where valueTupleOf = valueOf
instance MakeValueTuple Int64 (Value Int64) where valueTupleOf = valueOf
instance MakeValueTuple Word8 (Value Word8) where valueTupleOf = valueOf
instance MakeValueTuple Word16 (Value Word16) where valueTupleOf = valueOf
instance MakeValueTuple Word32 (Value Word32) where valueTupleOf = valueOf
instance MakeValueTuple Word64 (Value Word64) where valueTupleOf = valueOf
instance MakeValueTuple () () where valueTupleOf = id
instance IsType a =>
MakeValueTuple (Ptr a) (Value (Ptr a)) where valueTupleOf = valueOf
instance MakeValueTuple (StablePtr a) (Value (StablePtr a)) where valueTupleOf = valueOf
instance (TypeNum.Pos n, IsPrimitive a, IsConst a) =>
MakeValueTuple (Vector n a) (Value (Vector n a)) where valueTupleOf = valueOf
undefTuplePointed ::
(Undefined a, App.Applicative f) =>
f a
undefTuplePointed =
pure undefTuple
valueTupleOfFunctor ::
(MakeValueTuple h l, Functor f) =>
f h -> f l
valueTupleOfFunctor =
fmap valueTupleOf
phisTraversable ::
(Phi a, Trav.Traversable f) =>
BasicBlock -> f a -> CodeGenFunction r (f a)
phisTraversable bb x =
Trav.mapM (phis bb) x
addPhisFoldable ::
(Phi a, Fold.Foldable f, App.Applicative f) =>
BasicBlock -> f a -> f a -> CodeGenFunction r ()
addPhisFoldable bb x y =
Fold.sequence_ (liftA2 (addPhis bb) x y)