module LLVM.Core.Type(
IsType(..),
IsArithmetic,
IsInteger,
IsIntegerOrPointer,
IsFloating,
IsPrimitive,
IsFirstClass,
IsSized,
IsFunction,
UnknownSize,
IsPowerOf2,
NumberOfElements,
(:&), (&),
(:+->), ($+),
IsTuple(tupleDesc),
withTuple,
TypeDesc(..),
isFloating,
isSigned,
typeRef,
typeName,
VarArgs, CastVarArgs,
) where
import Data.Typeable
import Data.List(intercalate)
import Data.Int
import Data.Word
import Data.TypeLevel hiding (Bool, Eq)
import Foreign.StablePtr (StablePtr, )
import LLVM.Core.Util(functionType, structType)
import LLVM.Core.Data
import qualified LLVM.FFI.Core as FFI
class (Pos n) => IsPowerOf2 n
instance (LogBase D2 n l, ExpBase D2 l n) => IsPowerOf2 n
class IsType a where
typeDesc :: a -> TypeDesc
typeRef :: (IsType a) => a -> FFI.TypeRef
typeRef = code . typeDesc
where code TDFloat = FFI.floatType
code TDDouble = FFI.doubleType
code TDFP128 = FFI.fp128Type
code TDVoid = FFI.voidType
code (TDInt _ n) = FFI.integerType (fromInteger n)
code (TDArray n a) = FFI.arrayType (code a) (fromInteger n)
code (TDVector n a) = FFI.vectorType (code a) (fromInteger n)
code (TDPtr a) = FFI.pointerType (code a) 0
code (TDFunction va as b) = functionType va (code b) (map code as)
code TDLabel = FFI.labelType
code (TDStruct ts packed) = structType (map code ts) packed
typeName :: (IsType a) => a -> String
typeName = code . typeDesc
where code TDFloat = "f32"
code TDDouble = "f64"
code TDFP128 = "f128"
code TDVoid = "void"
code (TDInt _ n) = "i" ++ show n
code (TDArray n a) = "[" ++ show n ++ " x " ++ code a ++ "]"
code (TDVector n a) = "<" ++ show n ++ " x " ++ code a ++ ">"
code (TDPtr a) = code a ++ "*"
code (TDFunction _ as b) = code b ++ "(" ++ intercalate "," (map code as) ++ ")"
code TDLabel = "label"
code (TDStruct as packed) = (if packed then "<{" else "{") ++
intercalate "," (map code as) ++
(if packed then "}>" else "}")
data TypeDesc = TDFloat | TDDouble | TDFP128 | TDVoid | TDInt Bool Integer
| TDArray Integer TypeDesc | TDVector Integer TypeDesc
| TDPtr TypeDesc | TDFunction Bool [TypeDesc] TypeDesc | TDLabel
| TDStruct [TypeDesc] Bool
deriving (Eq, Ord, Show, Typeable)
class IsFirstClass a => IsArithmetic a
class (IsArithmetic a, IsIntegerOrPointer a) => IsInteger a
class IsIntegerOrPointer a
isSigned :: (IsInteger a) => a -> Bool
isSigned = is . typeDesc
where is (TDInt s _) = s
is (TDVector _ a) = is a
is _ = error "isSigned got impossible input"
class IsArithmetic a => IsFloating a
isFloating :: (IsArithmetic a) => a -> Bool
isFloating = is . typeDesc
where is TDFloat = True
is TDDouble = True
is TDFP128 = True
is (TDVector _ a) = is a
is _ = False
class (NumberOfElements D1 a) => IsPrimitive a
class (IsType a) => NumberOfElements n a | a -> n
class IsType a => IsFirstClass a
class (IsType a, Pos s) => IsSized a s | a -> s
data FunctionType = FunctionType Bool [TypeDesc] TypeDesc
mapFuncTypeArgs :: ([TypeDesc] -> [TypeDesc]) -> FunctionType -> FunctionType
mapFuncTypeArgs f ~(FunctionType vararg args result) =
(FunctionType vararg (f args) result)
class (IsType a) => IsFunction a where
funcTypeRec :: a -> FunctionType
funcType :: IsFunction a => a -> TypeDesc
funcType f =
case funcTypeRec f of
FunctionType vararg args result ->
TDFunction vararg args result
instance IsType Float where typeDesc _ = TDFloat
instance IsType Double where typeDesc _ = TDDouble
instance IsType FP128 where typeDesc _ = TDFP128
instance IsType () where typeDesc _ = TDVoid
instance IsType Label where typeDesc _ = TDLabel
instance (Pos n) => IsType (IntN n)
where typeDesc _ = TDInt True (toNum (undefined :: n))
instance (Pos n) => IsType (WordN n)
where typeDesc _ = TDInt False (toNum (undefined :: n))
instance IsType Bool where typeDesc _ = TDInt False 1
instance IsType Word8 where typeDesc _ = TDInt False 8
instance IsType Word16 where typeDesc _ = TDInt False 16
instance IsType Word32 where typeDesc _ = TDInt False 32
instance IsType Word64 where typeDesc _ = TDInt False 64
instance IsType Int8 where typeDesc _ = TDInt True 8
instance IsType Int16 where typeDesc _ = TDInt True 16
instance IsType Int32 where typeDesc _ = TDInt True 32
instance IsType Int64 where typeDesc _ = TDInt True 64
instance (Nat n, IsSized a s) => IsType (Array n a)
where typeDesc _ = TDArray (toNum (undefined :: n))
(typeDesc (undefined :: a))
instance (IsPowerOf2 n, IsPrimitive a) => IsType (Vector n a)
where typeDesc _ = TDVector (toNum (undefined :: n))
(typeDesc (undefined :: a))
instance (IsType a) => IsType (Ptr a) where
typeDesc _ = TDPtr (typeDesc (undefined :: a))
instance IsType (StablePtr a) where
typeDesc _ = TDPtr (typeDesc (undefined :: Int8))
instance (IsFirstClass a, IsFunction b) => IsType (a->b) where
typeDesc = funcType
instance (IsFirstClass a) => IsType (IO a) where
typeDesc = funcType
instance (StructFields a) => IsType (Struct a) where
typeDesc ~(Struct a) = TDStruct (fieldTypes a) False
instance (StructFields a) => IsType (PackedStruct a) where
typeDesc ~(PackedStruct a) = TDStruct (fieldTypes a) True
class StructFields as where
fieldTypes :: as -> [TypeDesc]
instance (IsSized a sa, StructFields as) => StructFields (a :& as) where
fieldTypes ~(a, as) = typeDesc a : fieldTypes as
instance StructFields () where
fieldTypes _ = []
infixr :&
type (:&) a as = (a, as)
infixr &
(&) :: a -> as -> a :& as
a & as = (a, as)
instance IsArithmetic Float
instance IsArithmetic Double
instance IsArithmetic FP128
instance (Pos n) => IsArithmetic (IntN n)
instance (Pos n) => IsArithmetic (WordN n)
instance IsArithmetic Bool
instance IsArithmetic Int8
instance IsArithmetic Int16
instance IsArithmetic Int32
instance IsArithmetic Int64
instance IsArithmetic Word8
instance IsArithmetic Word16
instance IsArithmetic Word32
instance IsArithmetic Word64
instance (IsPowerOf2 n, IsPrimitive a, IsArithmetic a) => IsArithmetic (Vector n a)
instance IsFloating Float
instance IsFloating Double
instance IsFloating FP128
instance (IsPowerOf2 n, IsPrimitive a, IsFloating a) => IsFloating (Vector n a)
instance (Pos n) => IsInteger (IntN n)
instance (Pos n) => IsInteger (WordN n)
instance IsInteger Bool
instance IsInteger Int8
instance IsInteger Int16
instance IsInteger Int32
instance IsInteger Int64
instance IsInteger Word8
instance IsInteger Word16
instance IsInteger Word32
instance IsInteger Word64
instance (IsPowerOf2 n, IsPrimitive a, IsInteger a) => IsInteger (Vector n a)
instance (Pos n) => IsIntegerOrPointer (IntN n)
instance (Pos n) => IsIntegerOrPointer (WordN n)
instance IsIntegerOrPointer Bool
instance IsIntegerOrPointer Int8
instance IsIntegerOrPointer Int16
instance IsIntegerOrPointer Int32
instance IsIntegerOrPointer Int64
instance IsIntegerOrPointer Word8
instance IsIntegerOrPointer Word16
instance IsIntegerOrPointer Word32
instance IsIntegerOrPointer Word64
instance (IsPowerOf2 n, IsPrimitive a, IsInteger a) => IsIntegerOrPointer (Vector n a)
instance (IsType a) => IsIntegerOrPointer (Ptr a)
instance IsFirstClass Float
instance IsFirstClass Double
instance IsFirstClass FP128
instance (Pos n) => IsFirstClass (IntN n)
instance (Pos n) => IsFirstClass (WordN n)
instance IsFirstClass Bool
instance IsFirstClass Int8
instance IsFirstClass Int16
instance IsFirstClass Int32
instance IsFirstClass Int64
instance IsFirstClass Word8
instance IsFirstClass Word16
instance IsFirstClass Word32
instance IsFirstClass Word64
instance (IsPowerOf2 n, IsPrimitive a) => IsFirstClass (Vector n a)
instance (Nat n, IsType a, IsSized a s) => IsFirstClass (Array n a)
instance (IsType a) => IsFirstClass (Ptr a)
instance IsFirstClass (StablePtr a)
instance IsFirstClass Label
instance IsFirstClass ()
instance (StructFields as) => IsFirstClass (Struct as)
instance IsSized Float D32
instance IsSized Double D64
instance IsSized FP128 D128
instance (Pos n) => IsSized (IntN n) n
instance (Pos n) => IsSized (WordN n) n
instance IsSized Bool D1
instance IsSized Int8 D8
instance IsSized Int16 D16
instance IsSized Int32 D32
instance IsSized Int64 D64
instance IsSized Word8 D8
instance IsSized Word16 D16
instance IsSized Word32 D32
instance IsSized Word64 D64
instance (Nat n, IsSized a s, Mul n s ns, Pos ns) => IsSized (Array n a) ns
instance (IsPowerOf2 n, IsPrimitive a, IsSized a s, Mul n s ns, Pos ns) => IsSized (Vector n a) ns
instance (IsType a) => IsSized (Ptr a) PtrSize
instance IsSized (StablePtr a) PtrSize
instance (StructFields as) => IsSized (Struct as) UnknownSize
instance (StructFields as) => IsSized (PackedStruct as) UnknownSize
type UnknownSize = D99
type PtrSize = D32
instance IsPrimitive Float
instance IsPrimitive Double
instance IsPrimitive FP128
instance (Pos n) => IsPrimitive (IntN n)
instance (Pos n) => IsPrimitive (WordN n)
instance IsPrimitive Bool
instance IsPrimitive Int8
instance IsPrimitive Int16
instance IsPrimitive Int32
instance IsPrimitive Int64
instance IsPrimitive Word8
instance IsPrimitive Word16
instance IsPrimitive Word32
instance IsPrimitive Word64
instance IsPrimitive Label
instance IsPrimitive ()
instance NumberOfElements D1 Float
instance NumberOfElements D1 Double
instance NumberOfElements D1 FP128
instance (Pos n) => NumberOfElements D1 (IntN n)
instance (Pos n) => NumberOfElements D1 (WordN n)
instance NumberOfElements D1 Bool
instance NumberOfElements D1 Int8
instance NumberOfElements D1 Int16
instance NumberOfElements D1 Int32
instance NumberOfElements D1 Int64
instance NumberOfElements D1 Word8
instance NumberOfElements D1 Word16
instance NumberOfElements D1 Word32
instance NumberOfElements D1 Word64
instance NumberOfElements D1 Label
instance NumberOfElements D1 ()
instance (IsPowerOf2 n, IsPrimitive a) =>
NumberOfElements n (Vector n a)
instance (IsFirstClass a, IsFunction b) => IsFunction (a->b) where
funcTypeRec _ =
mapFuncTypeArgs (typeDesc (undefined :: a) :) $
funcTypeRec (undefined :: b)
instance (IsFirstClass a) => IsFunction (IO a) where
funcTypeRec _ = FunctionType False [] (typeDesc (undefined :: a))
instance (IsFirstClass a) => IsFunction (VarArgs a) where
funcTypeRec _ = FunctionType True [] (typeDesc (undefined :: a))
newtype (:+->) a b = TupleFunction (a -> b)
infixr 0 :+->
infixl 9 $+
($+) :: (a :+-> b) -> (a -> b)
($+) (TupleFunction f) = f
withTuple :: (a -> b) -> (a :+-> b)
withTuple = TupleFunction
class IsTuple a where
tupleDesc :: a -> [TypeDesc]
atomDesc :: IsType a => a -> [TypeDesc]
atomDesc x = [typeDesc x]
instance IsTuple () where
tupleDesc _ = []
instance (IsTuple a, IsTuple b) =>
IsTuple (a,b) where
tupleDesc ~(a,b) =
tupleDesc a ++ tupleDesc b
instance (IsTuple a, IsTuple b, IsTuple c) =>
IsTuple (a,b,c) where
tupleDesc ~(a,b,c) =
tupleDesc a ++ tupleDesc b ++ tupleDesc c
instance IsTuple (Float) where tupleDesc = atomDesc
instance IsTuple (Double) where tupleDesc = atomDesc
instance IsTuple (FP128) where tupleDesc = atomDesc
instance (Pos n) =>
IsTuple ((IntN n)) where tupleDesc = atomDesc
instance (Pos n) =>
IsTuple ((WordN n)) where tupleDesc = atomDesc
instance IsTuple (Bool) where tupleDesc = atomDesc
instance IsTuple (Int8) where tupleDesc = atomDesc
instance IsTuple (Int16) where tupleDesc = atomDesc
instance IsTuple (Int32) where tupleDesc = atomDesc
instance IsTuple (Int64) where tupleDesc = atomDesc
instance IsTuple (Word8) where tupleDesc = atomDesc
instance IsTuple (Word16) where tupleDesc = atomDesc
instance IsTuple (Word32) where tupleDesc = atomDesc
instance IsTuple (Word64) where tupleDesc = atomDesc
instance (IsPowerOf2 n, IsPrimitive a) =>
IsTuple ((Vector n a)) where tupleDesc = atomDesc
instance (IsType a) =>
IsTuple ((Ptr a)) where tupleDesc = atomDesc
instance IsTuple ((StablePtr a)) where tupleDesc = atomDesc
instance (IsTuple a, IsFunction b) => IsType (a:+->b) where
typeDesc = funcType
instance (IsTuple a, IsFunction b) => IsFunction (a:+->b) where
funcTypeRec _ =
mapFuncTypeArgs (tupleDesc (undefined :: a) ++ ) $
funcTypeRec (undefined :: b)
data VarArgs a
deriving (Typeable)
instance IsType (VarArgs a) where
typeDesc _ = error "typeDesc: Dummy type VarArgs used incorrectly"
class CastVarArgs a b
instance (CastVarArgs b c) => CastVarArgs (a -> b) (a -> c)
instance CastVarArgs (VarArgs a) (IO a)
instance (IsFirstClass a, CastVarArgs (VarArgs b) c) => CastVarArgs (VarArgs b) (a -> c)