{-# LANGUAGE CPP, DeriveDataTypeable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, IncoherentInstances, MultiParamTypeClasses, ScopedTypeVariables, TypeOperators, TypeSynonymInstances, UndecidableInstances #-} -- |The LLVM type system is captured with a number of Haskell type classes. -- In general, an LLVM type @T@ is represented as @Value T@, where @T@ is some Haskell type. -- The various types @T@ are classified by various type classes, e.g., 'IsFirstClass' for -- those types that are LLVM first class types (passable as arguments etc). -- All valid LLVM types belong to the 'IsType' class. module LLVM.Core.Type( -- * Type classifier IsType(..), -- * StructFields classifier StructFields, -- ** Special type classifiers Nat, Pos, IsArithmetic(arithmeticType), ArithmeticType(IntegerType,FloatingType), IsInteger, IsIntegerOrPointer, IsFloating, IsPrimitive, IsFirstClass, IsSized, IsFunction, -- ** Others NumberOfElements, UnknownSize, -- needed for arrays of structs -- ** Structs (:&), (&), -- ** Type tests TypeDesc(..), isFloating, isSigned, typeRef, typeName, typeDesc2, VarArgs, CastVarArgs, ) where import Data.Data 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 #include "MachDeps.h" -- TODO: -- Move IntN, WordN to a special module that implements those types -- properly in Haskell. -- Also more Array and Vector to a Haskell module to implement them. -- Add Label? -- Add structures (using tuples, maybe nested). -- |The 'IsType' class classifies all types that have an LLVM representation. class IsType a where typeDesc :: a -> TypeDesc typeRef :: (IsType a) => a -> FFI.TypeRef -- ^The argument is never evaluated 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 code TDInvalidType = error "typeRef TDInvalidType" 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 "}") code TDInvalidType = error "typeName TDInvalidType" typeDesc2 :: FFI.TypeRef -> IO TypeDesc typeDesc2 t = do tk <- FFI.getTypeKind t case tk of FFI.VoidTypeKind -> return TDVoid FFI.FloatTypeKind -> return TDFloat FFI.DoubleTypeKind -> return TDDouble -- FIXME: FFI.X86_FP80TypeKind -> return "X86_FP80" FFI.FP128TypeKind -> return TDFP128 -- FIXME: FFI.PPC_FP128TypeKind -> return "PPC_FP128" FFI.LabelTypeKind -> return TDLabel FFI.IntegerTypeKind -> do n <- FFI.getIntTypeWidth t return $ TDInt False (fromIntegral n) -- FIXME: FFI.FunctionTypeKind -- FIXME: FFI.StructTypeKind -> return "(Struct ...)" FFI.ArrayTypeKind -> do n <- FFI.getArrayLength t et <- FFI.getElementType t etd <- typeDesc2 et return $ TDArray (fromIntegral n) etd FFI.PointerTypeKind -> do et <- FFI.getElementType t etd <- typeDesc2 et return $ TDPtr etd -- FIXME: FFI.OpaqueTypeKind -> return "Opaque" FFI.VectorTypeKind -> do n <- FFI.getVectorSize t et <- FFI.getElementType t etd <- typeDesc2 et return $ TDVector (fromIntegral n) etd -- FIXME: LLVMMetadataTypeKind, /**< Metadata */ -- FIXME: LLVMX86_MMXTypeKind /**< X86 MMX */ _ -> return TDInvalidType -- |Type descriptor, used to convey type information through the LLVM API. 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 | TDInvalidType deriving (Eq, Ord, Show, Typeable, Data) -- XXX isFloating and typeName could be extracted from typeRef -- Usage: -- superclass of IsConst -- add, sub, mul, neg context -- used to get type name to call intrinsic -- |Arithmetic types, i.e., integral and floating types. class IsFirstClass a => IsArithmetic a where arithmeticType :: ArithmeticType a data ArithmeticType a = IntegerType | FloatingType instance Functor ArithmeticType where fmap _ IntegerType = IntegerType fmap _ FloatingType = FloatingType -- Usage: -- constI, allOnes -- many instructions. XXX some need vector -- used to find signedness in Arithmetic -- |Integral types. class (IsArithmetic a, IsIntegerOrPointer a) => IsInteger a -- Usage: -- icmp -- |Integral or pointer type. 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" -- Usage: -- constF -- many instructions -- |Floating types. 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 -- Usage: -- Precondition for Vector -- |Primitive types. class (NumberOfElements D1 a) => IsPrimitive a -- |Number of elements for instructions that handle both primitive and vector types class (IsType a) => NumberOfElements n a | a -> n -- Usage: -- Precondition for function args and result. -- Used by some instructions, like ret and phi. -- XXX IsSized as precondition? -- |First class types, i.e., the types that can be passed as arguments, etc. class IsType a => IsFirstClass a -- Usage: -- Context for Array being a type -- thus, allocation instructions -- |Types with a fixed size. class (IsType a, Pos s) => IsSized a s | a -> s -- |Function type. class (IsType a) => IsFunction a where funcType :: [TypeDesc] -> a -> TypeDesc -- Only make instances for types that make sense in Haskell -- (i.e., some floating types are excluded). -- Floating point types. instance IsType Float where typeDesc _ = TDFloat instance IsType Double where typeDesc _ = TDDouble instance IsType FP128 where typeDesc _ = TDFP128 -- Void type instance IsType () where typeDesc _ = TDVoid -- Label type instance IsType Label where typeDesc _ = TDLabel -- Variable size integer types 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)) -- Fixed size integer types. 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 -- Sequence types instance (Nat n, IsSized a s) => IsType (Array n a) where typeDesc _ = TDArray (toNum (undefined :: n)) (typeDesc (undefined :: a)) instance (Pos n, IsPrimitive a) => IsType (Vector n a) where typeDesc _ = TDVector (toNum (undefined :: n)) (typeDesc (undefined :: a)) -- Pointer type. instance (IsType a) => IsType (Ptr a) where typeDesc _ = TDPtr (typeDesc (undefined :: a)) instance IsType (StablePtr a) where typeDesc _ = TDPtr (typeDesc (undefined :: Int8)) {- typeDesc _ = TDPtr TDVoid List: Type.cpp:1311: static llvm::PointerType* llvm::PointerType::get(const llvm::Type*, unsigned int): Assertion `ValueType != Type::VoidTy && "Pointer to void is not valid, use sbyte* instead!"' failed. -} -- Functions. instance (IsFirstClass a, IsFunction b) => IsType (a->b) where typeDesc = funcType [] -- Function base type, always IO. instance (IsFirstClass a) => IsType (IO a) where typeDesc = funcType [] -- Struct types, basically a list of component types. 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 -- Use a nested tuples for struct fields. 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 _ = [] -- An alias for pairs to make structs look nicer infixr :& type (:&) a as = (a, as) infixr & (&) :: a -> as -> a :& as a & as = (a, as) --- Instances to classify types instance IsArithmetic Float where arithmeticType = FloatingType instance IsArithmetic Double where arithmeticType = FloatingType instance IsArithmetic FP128 where arithmeticType = FloatingType instance (Pos n) => IsArithmetic (IntN n) where arithmeticType = IntegerType instance (Pos n) => IsArithmetic (WordN n) where arithmeticType = IntegerType instance IsArithmetic Bool where arithmeticType = IntegerType instance IsArithmetic Int8 where arithmeticType = IntegerType instance IsArithmetic Int16 where arithmeticType = IntegerType instance IsArithmetic Int32 where arithmeticType = IntegerType instance IsArithmetic Int64 where arithmeticType = IntegerType instance IsArithmetic Word8 where arithmeticType = IntegerType instance IsArithmetic Word16 where arithmeticType = IntegerType instance IsArithmetic Word32 where arithmeticType = IntegerType instance IsArithmetic Word64 where arithmeticType = IntegerType instance (Pos n, IsPrimitive a, IsArithmetic a) => IsArithmetic (Vector n a) where arithmeticType = fmap (undefined :: a -> Vector n a) arithmeticType instance IsFloating Float instance IsFloating Double instance IsFloating FP128 instance (Pos 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 (Pos 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 (Pos 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 (Pos 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 () -- XXX This isn't right, but () can be returned 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 (Pos 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 IsSized Label PtrSize -- labels are not quite first classed -- We cannot compute the sizes statically :( instance (StructFields as) => IsSized (Struct as) UnknownSize instance (StructFields as) => IsSized (PackedStruct as) UnknownSize type UnknownSize = D99 -- XXX this is wrong! #if WORD_SIZE_IN_BITS == 32 type PtrSize = D32 #elif WORD_SIZE_IN_BITS == 64 type PtrSize = D64 #else #error cannot determine type of PtrSize #endif 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 (Pos n, IsPrimitive a) => NumberOfElements n (Vector n a) -- Functions. instance (IsFirstClass a, IsFunction b) => IsFunction (a->b) where funcType ts _ = funcType (typeDesc (undefined :: a) : ts) (undefined :: b) instance (IsFirstClass a) => IsFunction (IO a) where funcType ts _ = TDFunction False (reverse ts) (typeDesc (undefined :: a)) instance (IsFirstClass a) => IsFunction (VarArgs a) where funcType ts _ = TDFunction True (reverse ts) (typeDesc (undefined :: a)) -- |The 'VarArgs' type is a placeholder for the real 'IO' type that -- can be obtained with 'castVarArgs'. data VarArgs a deriving (Typeable) instance IsType (VarArgs a) where typeDesc _ = error "typeDesc: Dummy type VarArgs used incorrectly" -- |Define what vararg types are permissible. 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) -- XXX Structures not implemented. Tuples is probably an easy way.